VBA Lotus Notes using MIME HTML and attaching a PDF in Email Body

[Drawleeh]

Hello, I have some code that I had thought worked fine but turns out doesn't. My code sends an email using VBA through lotus notes, it first attaches a PDF document to the email via RichText, which works and the PDF is attached. Then it uses MIME to attach a HTML to the body so I can get some lovely formatted text before it sends the whole email to users that are provided via Excel table. What is strange that in the sent box it all seems to work fine and the PDF attachment is there as well as the HTML body.

I have checked however and for external users they don't get the PDF attachment. If I remove the MIME part of the code the PDF is attached fine but I can't lose the HTML body. Question then, can I fix this to use both RichText embedded attachment and a MIME body or otherwise how do I use MIME to embed another PDF attachment alongside the HTML body?

Public Sub COM_Email_Send()

Dim NSession As Object
Dim NMailDb As Object
Dim NDocument As Object
Dim NBody As Object
Dim NChild As Object
Dim Nstream As Object
Dim RichTextHeader As Object

Dim i As Long
Dim Row As Long
Dim Recipient As String
Dim File As String
Dim attachmentFile As String
Dim Data As String
Dim AttachedOb As Object
Dim EmbedOb As Object
Dim NHeader As Object
Dim strFileType As Variant
Dim MIMEDoc As Object

Set NSession = CreateObject("Lotus.NotesSession")
Call NSession.Initialize("password")

Set NMailDb = NSession.GetDatabase("directory", "server")
If Not NMailDb.IsOpen = True Then
Call NMailDb.Open
End If

    Row = Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
    
    For i = 1 To Row
    
    Recipient = Worksheets("Sheet1").Range("B" & i)
    
    If Recipient <> "" Then
    
    
    File = Worksheets("Sheet1").Range("A" & i).Value
    
    attachmentFile = "Directory" & File
    
    Data = Format(Now(), "dd/mm/yyyy")


    Set NDocument = NMailDb.CreateDocument
    Set Nstream = NSession.CreateStream
    
    
    Call NDocument.replaceitemvalue("Form", "Memo")
    Call NDocument.replaceitemvalue("SendTo", Recipient)
    Call NDocument.replaceitemvalue("Subject", "Please see your clearance documents attached " & Data)
    Call NDocument.replaceitemvalue("Sender", "noreply@test.com")
    
    If attachmentFile <> "" Then
    Set AttachedOb = NDocument.Createrichtextitem("attachmentFile")
    Set EmbedOb = AttachedOb.embedobject(1454, "", attachmentFile, "")
    End If
    
    Call Nstream.Open("Directory\HTML BODY.htm")
    Set NBody = NDocument.CreateMIMEEntity '("memo")
    Set RichTextHeader = NBody.CreateHeader("Content-Type")
    Call RichTextHeader.SetHeaderVal("multipart/mixed")
    Set MIMEDoc = NBody.CreateChildEntity()
    
    Call MIMEDoc.SetContentFromBytes(Nstream, "text/html", ENC_IDENTITY_BINARY)
    Call Nstream.Close
    
    
    
    NDocument.savemessageonsend = True
    
    Call NDocument.replaceitemvalue("PostedDate", Now())
    Call NDocument.Send(False)
    

    Set NDocument = Nothing
    Set Nstream = Nothing
    
    End If
    Next i
    
End Sub

 

[John_w]

You need to put everything - the HTML email body (with HTML and plain text parts) and the file attachment in a multipart MIME message with the following structure:

                'Content-Type: multipart/mixed header - main body header
                'Content-Type: multipart/alternative - 1st part header for plain text and HTML parts
                '   Content-Type: text/plain header
                '       Plain text email body content
                '   Content-Type: text/html header
                '       HTML email body content
                'Content-Type: application/pdf - 2nd part header for attachment
                'Content-Disposition: attachment filename="file.pdf"
                '   file.pdf bytes

This code uses early binding of the Lotus Notes COM library so it requires a reference to Lotus Domino Objects, set via Tools -> References in the VBA editor.

'Reference: Lotus Domino Objects

Option Explicit

Public Sub COM_Send_Emails()

    Dim NSession As Domino.NotesSession
    Dim NMailDb As Domino.NotesDatabase
    Dim NDocument As Domino.NotesDocument
    Dim NStream As Domino.NotesStream
    Dim NMimeBody As Domino.NotesMIMEEntity
    Dim NMimeAlternative As Domino.NotesMIMEEntity
    Dim NMimePlain As Domino.NotesMIMEEntity
    Dim NMimeHTML As Domino.NotesMIMEEntity
    Dim inFile As Object
    Dim i As Long
    Dim lastRow As Long
    Dim recipient As String
    Dim attachmentFile As String
    Dim HTMLemailBody As String

    'Read the HTML file contents into a string
 
    With CreateObject("Scripting.FileSystemObject")
        Set inFile = .OpenTextFile("Directory\HTML BODY.htm")
        HTMLemailBody = inFile.ReadAll
        inFile.Close
    End With
 
    'Start a session to Lotus Notes
 
    Set NSession = New Domino.NotesSession                      'COM - early binding

    'Get mail database
 
    With NSession
        .Initialize "password"
        .ConvertMime = False        'do not convert MIME to rich text
        Set NMailDb = .GetDatabase("directory", "server")
        If Not NMailDb.IsOpen Then NMailDb.Open
    End With
 
    For i = 1 To Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
 
        recipient = Worksheets("Sheet1").Range("B" & i)
     
        If recipient <> "" Then
     
            attachmentFile = "Directory" & Worksheets("Sheet1").Range("A" & i).Value
         
            'Create stream for writing data to the MIME entities
         
            Set NStream = NSession.CreateStream
         
            'Create email document
         
            Set NDocument = NMailDb.CreateDocument
         
            With NDocument
         
                .ReplaceItemValue "Form", "Memo"
                .ReplaceItemValue "SendTo", recipient
                .ReplaceItemValue "Subject", "Please see your clearance documents attached " & Format(Date, "dd/mm/yyyy")
                .ReplaceItemValue "Sender", "noreply@test.com"
                     
                'Create the following MIME hierarchy within NDocument
             
                'Content-Type: multipart/mixed header - main body header
                'Content-Type: multipart/alternative - 1st part header for plain text and HTML parts
                '   Content-Type: text/plain header
                '       Plain text email body content
                '   Content-Type: text/html header
                '       HTML email body content
                'Content-Type: application/pdf - 2nd part header for attachment
                'Content-Disposition: attachment filename="file.pdf"
                '   file.pdf bytes
 
                'Create the main MIME body entity.  This is automatically given a Content-Type of multipart/mixed by Notes
                'when its first child (NMimeAlternative) is created below
         
                Set NMimeBody = .CreateMIMEEntity
         
                'Create child 1 of NMimeBody - this will contain the plain text and HTML parts of the email body in Content-Type: multipart/alternative
             
                Set NMimeAlternative = NMimeBody.CreateChildEntity
             
                'Create child 1 within NMimeAlternative for the plain text content
                'This creates a MIME header with content-type "multipart/mixed". Change this to "multipart/alternative" because
                'this entity holds the alternative plain text version of the email body
             
                Set NMimePlain = NMimeAlternative.CreateChildEntity                     'NMimePlain = Child 1 of NMimeAlternative
                SetContentType NMimeAlternative, NMimePlain, "multipart/alternative"
             
                'Create child 2 within NMimeAlternative for the Plain text content
             
                Set NMimeHTML = NMimeAlternative.CreateChildEntity                      'NMimeHTML = Child 2 of NMimeAlternative
             
                'Write plain text to the stream and add it to the Plain text part
             
                NStream.WriteText HTMLtoText(HTMLemailBody)
                NMimePlain.SetContentFromText NStream, "text/plain; charset=ISO-8859-1", ENC_NONE
                NStream.Close
             
                'Write HTML to the stream and add it to the HTML part

                NStream.WriteText HTMLemailBody
                NMimeHTML.SetContentFromText NStream, "text/html; charset=UTF-8", ENC_NONE
                NStream.Close
                             
                'For the file attachment, add a child MIME entity to the MIME body and the file bytes in a Content-Disposition header
         
                If Dir(attachmentFile) <> vbNullString Then
                    AddAttachment NSession, NMimeBody, attachmentFile
                End If
                             
                .SaveMessageOnSend = True
                .ReplaceItemValue "PostedDate", Now
                .Send False
     
            End With
         
            Set NDocument = Nothing
            Set NStream = Nothing
     
        End If
 
    Next
 
End Sub


Private Sub SetContentType(NMimeParent As NotesMIMEEntity, NMimeChild As NotesMIMEEntity, ContentType As String)

    Dim NMimeHeader As NotesMIMEHeader
     
    Set NMimeHeader = NMimeParent.GetNthHeader("Content-Type")
    NMimeHeader.SetHeaderValAndParams ContentType & "; boundary=" & Chr(34) & NMimeChild.BoundaryStart & Chr(34)
 
End Sub


Private Sub AddAttachment(NSession As Domino.NotesSession, NMimeBody As Domino.NotesMIMEEntity, attachmentFile As String)

    Dim NMimeAttachment As Domino.NotesMIMEEntity
    Dim NMimeHeader As Domino.NotesMIMEHeader
    Dim NStream As Domino.NotesStream
    Dim ContentType As String
    Dim fileName As String

    fileName = Mid(attachmentFile, InStrRev(attachmentFile, "\") + 1)

    'Create MIME child entity to hold the file attachment within the body
 
    Set NMimeAttachment = NMimeBody.CreateChildEntity

    ContentType = GetContentType(fileName)
    Set NMimeHeader = NMimeAttachment.CreateHeader("Content-Type")
    NMimeHeader.SetHeaderValAndParams ContentType & "; name=" & Chr(34) & fileName & Chr(34)
 
    Set NMimeHeader = NMimeAttachment.CreateHeader("Content-Disposition")
    NMimeHeader.SetHeaderValAndParams "attachment; filename=" & Chr(34) & fileName & Chr(34)
 
    'Write file contents to a new stream
 
    Set NStream = NSession.CreateStream
    With NStream
        If Not .Open(attachmentFile, "binary") Then
            Debug.Print "Open failed"
        End If
        If .Bytes = 0 Then
            Debug.Print "File is empty"
        End If
             
        'Write stream contents to MIME attachment entity
     
        NMimeAttachment.SetContentFromBytes NStream, ContentType, ENC_IDENTITY_BINARY
        .Close
    End With
 
End Sub


Public Function GetContentType(fileName As String)

    'Return Content Type string based on a filename's file extension
 
    Dim p As Long
    Dim ext As String

    p = InStrRev(fileName, ".")
    If p > 0 Then
        ext = Mid(fileName, p + 1)
    Else
        ext = ""
    End If
 
    Select Case LCase(ext)
        Case "gif":         GetContentType = "image/gif"
        Case "png":         GetContentType = "image/png"
        Case "jpg", "jpeg": GetContentType = "image/jpeg"
        Case "doc", "docx": GetContentType = "application/vnd.ms-word"
        Case "xls", "xlsx": GetContentType = "application/vnd.ms-excel"
        Case "csv":         GetContentType = "application/octet-stream"
        Case "pdf":         GetContentType = "application/pdf"
        Case "zip":         GetContentType = "application/zip"
        Case Else:          GetContentType = "image/gif"
    End Select

End Function


Private Function HTMLtoText(HTML As String) As String
 
    'Convert a HTML string to plain text
 
    Dim HTMLdoc As Object
 
    Set HTMLdoc = CreateObject("HTMLfile")
    HTMLdoc.Open
    HTMLdoc.Write HTML
    HTMLdoc.Close
    HTMLtoText = HTMLdoc.body.innerText

End Function

Edit - minor correction to AddAttachment routine without affecting the result.

 

[Drawleeh]

Thank you for your response John, I appreciate your help! I did end up working it out in the end using a similar approach as above. I was hoping if you knew if there was a reference that could help me match an email that was replied to in the inbox view with the reply email saved in the sent view. I know NotesDocuments.GetItemValue has a lot of options and can tell me whether an email has been replied to but I don't know of a reference that would help me find the reply in the sent view automatically.

 

[John_w]

I'll reply in your other thread.