VbaFin.com

Visual Basic for Financial Professionals
   Home      Lotus Notes
This snippet is based on IBM's example how to send Lotus Notes mail message with Microsoft Visual Basic. I had to tweak it just a little bit to make it work on my PC and allow for multiple attachments and formatted (html body text).  

References Lotus Notes Email VBA Project
Lotus Domino Objects library needs to be installed for the macro to work. It might or might not be referenced as late binding is used.
 
More information about using Lotus Notes COM objects with Visual basic can be found in their redbook article on the subject.
 
Sub SendNotesMail(Recipient, Optional ccRecipient, Optional bccRecipient, _
    Optional Subject As String, Optional Attachment, _
    Optional BodyText As String, Optional SaveIt As Boolean)
   
    Dim Maildb As Object 'The mail database
    Dim UserName As String 'The current users notes name
    Dim MailDbName As String 'The current users notes mail database name
    Dim MailDoc As Object 'The mail document itself
    Dim AttachME As Object 'The attachment richtextfile object
    Dim Session As Object 'The notes session
    Dim i As Long, e As Long
    On Error GoTo ErrHdl
    'Start a session to notes
    Set Session = CreateObject("Notes.NotesSession")
   Session.ConvertMIME = False
    'Next line only works with 5.x and above. Replace password with your password
    'Session.Initialize ("password")
    'Get the sessions username and then calculate the mail file name
    'You may or may not need this as for MailDBname with some systems you
    'can pass an empty string or using above password you can use other mailboxes.
    UserName = Session.UserName
    MailDbName = Left$(UserName, 1) & Right$(UserName, (Len(UserName) - InStr(1, UserName, " "))) & ".nsf"
    'Open the mail database in notes
    Set Maildb = Session.GetDatabase("", MailDbName)
    If Not Maildb.IsOpen Then Maildb.OPENMAIL
    'Set up the new mail document
    Set MailDoc = Maildb.CreateDocument
    MailDoc.Form = "Memo"
    MailDoc.sendto = Recipient
    MailDoc.Subject = Subject
    'MailDoc.Body = BodyText was replaced by the 3 rows below
   Set Body = MailDoc.CreateMIMEEntity
    Stream.WriteText BodyText
   
'ENC_IDENTITY_8BIT used because of technote found on notes.net
    'http://www-10.lotus.com/ldd/nd6forum.nsf/55c38d716d632d9b8525689b005ba1c0
    '/aeedaf28e47546ad85256f6a000a4b48?OpenDocument
    Body.SetContentFromText Stream, "text/html;charset=iso-8859-1", ENC_IDENTITY_8BIT
    Session.ConvertMIME = Tr
ue

    MailDoc.SaveMessageOnSend = SaveIt
    If Not IsMissing(ccRecipient) Then MailDoc.CopyTo = ccRecipient
    If Not IsMissing(bccRecipient) Then MailDoc.BlindCopyTo = bccRecipient
    'Set up the embedded object and attachment and attach it
    If Not IsArray(Attachment) Then
        If IsMissing(Attachment) Then Attachment = ""
        If IsError(Attachment) Then Attachment = ""
        If Attachment <> "" Then
            Set AttachME = MailDoc.CreateRichTextItem("Attachment")
            If Len(Dir(Attachment)) > 0 Then AttachME.EmbedObject 1454, "", Attachment, "Attachment"
            'MailDoc.CreateRichTextItem ("Attachment")
        End If
    Else
        ReDim EmbedObjArr(LBound(Attachment) To UBound(Attachment))
        Set AttachME = MailDoc.CreateRichTextItem("Attachment")
        For i =LBound(Attachment) To UBound(Attachment)
            If IsError(Attachment(i)) Then Attachment(i) = ""
            If Len((Attachment(i))) > 0 Then
                If Len(Dir(Attachment(i))) > 0 Then AttachME.EmbedObject 1454, "", Attachment(i), "Attachment"
            End If
        Next i
    End If
    'Send the document
    MailDoc.PostedDate = Now() 'Gets the mail to appear in the sent items folder
    MailDoc.Send 0, Recipient
ErrHdl:
    'Error Handling
    If Err.Number Then
        MsgBox "SendNotesEmail macro generated an error: " & Err.Description, vbCritical, "VBA Error"
    End If
    'Clean Up
    Set Maildb =Nothing
    Set MailDoc =Nothing
    Set AttachME =Nothing
    Set Session =Nothing
    Set EmbedObj =Nothing
   Set Body =Nothing
 
End Sub