VBA LOTUS NOTES DOMINO - Código de envio de e-mails

Algumas pessoas no ano passado e já neste ano solicitaram código sobre como enviar e-mail no Lotus Notes Domino.

Seguem possibilidades de fazê-lo. Como sempre, divirtam-se:

Public Sub EnviarMailViaNotes (Subject As String, Attachment As String, Recipient As String, BodyText As String, SaveIt As Boolean)

    Dim Maildb As Object

    Dim UserName As String 

    Dim MailDbName As String 

    Dim MailDoc As Object

    Dim AttachME As Object 

    Dim Session As Object 

    Dim EmbedObj As Object 

    Set Session = CreateObject("Notes.NotesSession")

    Session.Initialize("password")

   

    Let UserName = Session.UserName

    

    Let MailDbName = Left$(UserName, 1) & Right$(UserName, (Len(UserName) - InStr(1, UserName, " "))) & ".nsf"

    

    Set Maildb = Session.GETDATABASE("", MailDbName)

     If Maildb.ISOPEN = True Then

          

     Else

         Maildb.OPENMAIL

     End If

    

    Set MailDoc = Maildb.CREATEDOCUMENT

    

    Let MailDoc.Form = "Memo"    
    Let MailDoc.sendto = Recipient
    Let MailDoc.Subject = Subject    
    Let MailDoc.Body = BodyText    
    Let MailDoc.SAVEMESSAGEONSEND = SaveIt

    

    If Attachment <> "" Then

        Set AttachME = MailDoc.CREATERICHTEXTITEM("Attachment")

        Set EmbedObj = AttachME.EMBEDOBJECT(1454, "", Attachment, "Attachment")

        MailDoc.CREATERICHTEXTITEM ("Attachment")

    End If

    

    

    Let MailDoc.PostedDate=Now() 

    MailDoc.SEND 0, Recipient

    

    Set Maildb = Nothing

    Set MailDoc = Nothing

    Set AttachME = Nothing

    Set Session = Nothing

    Set EmbedObj = Nothing

End Sub

Se desejar enviar o e-mail para mais de uma pessoa, Let MailDoc.sendto = Recipient

Let MailDoc.CopyTo = ccRecipientLet MailDoc.BlindCopyTo = bccRecipient

Se desejar enviar para múltiplos e-mails, que tenham sido carregados num vetor,

Dim recip(25) as variant

Let recip(0) = "emailaddress1"

Let recip(1) = "emailaddress2" e.t.c

Let maildoc.sendto = recip

OUTRO MODO

Sub SendMailAttachment () 

    Dim strBOdocument As String 

    Dim strBOUserDocsPath As String 

    

    Let strBOUserDocsPath = busobj.ActiveDocument.Path & "\" 

    

    

    Let strBOdocument = Application.ActiveDocument.Name 

    

    Application.ActiveDocument.SaveAs (strBOUserDocsPath & strBOdocument & ".xls")    

    Dim domSession As New NotesSession 

    Dim domNotesDBMailFile As NotesDatabase 

    Dim domNotesDocumentMemo As NotesDocument 

    Dim domNotesRichText As NotesRichTextItem 

    Dim strAttachment As String 

    

    domSession.Initialize ("")

    

    Set domNotesDBMailFile = domSession.GetDatabase("", "names.nsf") 

    Set domNotesDocumentMemo = domNotesDBMailFile.CreateDocument 

    

    Call domNotesDocumentMemo.AppendItemValue("Form", "Memo") 

    Call domNotesDocumentMemo.AppendItemValue("SendTo", domSession.CommonUserName) 

    Call domNotesDocumentMemo.AppendItemValue("Subject", strBOdocument) 

    

    Set domNotesRichText = domNotesDocumentMemo.CreateRichTextItem("Body") 

    

    strAttachment = strBOUserDocsPath & strBOdocument & ".xls" 

    

    Call domNotesRichText.EmbedObject(EMBED_ATTACHMENT, "", strAttachment, "") 

    

    domNotesRichText.AppendText (InputBox("Digite algum texto adicional que deseje acrescentar.", _ 

    " Este aparecerá no corpo do e-mail.")) 

    

    domNotesDocumentMemo.Send (False) 

End Sub

Evoque-o assim:

Private Sub Document_AfterRefresh() 
    ThisDocument.ExecuteMacro ("SendMailAttachment") 
End Sub 

Private Sub Document_AfterRefresh() 
    SendMailAttachment 
End Sub

Tags: Bernardes, VBA, Office, e-Mail, Send, Mail, Lotus, Notes, Domino, Attachment, Recipient, CCo, Bco, CC

André Luiz Bernardes

A&A® - Work smart, not hard.

VBA Blogs

  

bernardes@.com