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
Nenhum comentário:
Postar um comentário