Rotina completa para envio de e-mail

Public Sub email(destinatario As Variant, copia As Variant, copiaoculta As Variant, _
assunto As String, texto As String, remetente As String, doc As notesdocument)
Dim docmsg As NotesDocument
Dim itemrtf As notesrichtextitem
Dim itemrecipients As notesitem
Dim itemcopyto As notesitem
Dim itemblindcopyto As notesitem

On Error Goto ErrorHandler

Set docmsg = New NotesDocument(BdLocal)

docmsg.Form="Memo"

If remetente <> "" Then

docmsg.From = remetente
docmsg.Principal = remetente

Else

docmsg.From = Sessao.username
docmsg.Principal = Sessao.username

End If

docmsg.SendTo = destinatario
docmsg.CopyTo = copia
docmsg.BlindCopyTo = copiaoculta

docmsg.Recipients = docmsg.SendTo
Set itemrecipients = docmsg.getfirstitem("Recipients")
Set itemcopyto = docmsg.getfirstitem("CopyTo")
Set itemblindcopyto = docmsg.getfirstitem("BlindCopyTo")

Forall d In itemcopyto.values
itemrecipients.appendtotextlist d
End Forall

Forall d In itemblindcopyto.values
itemrecipients.appendtotextlist d
End Forall


docmsg.subject = assunto

Set itemrtf = docmsg.createrichtextitem("Body")
Call itemrtf.appendtext(texto)
Call itemrtf.AddNewLine( 2 )

If Not(doc Is Nothing) Then
Call itemrtf.AppendText("Para abrir o documento clique aqui -> ")
Call itemrtf.AppendDocLink( doc, "" )
Call itemrtf.AddNewLine( 2 )
End If

docmsg.PostedDate = Now

docmsg.savemessagemonsend = False
docmsg.send False

Exit Sub

ErrorHandler:
If Err>=1000 And Err<=1999 Then
Error Err, Error$
Else
Error Err, "ScriptLibrary Core - Função Email - Erro : " + Error + " - linha : " + Cstr(Erl)
End If
End Sub