Macro to send multiple files or folder to ONE receipent in Lotus Notes

[Dillon66]

Hi Guys,

I was given a link to a post on this site for a macro code that can send attachments in lotus notes by reading a list of recipients and file paths collated in excel. This macro works brilliantly sending one file per email. However, I now need to tweak it so that it can send a number of files to one email address but on the same email instead of individual emails. Alternatively, if it would be easier, referencing a folder name containing the files and sending the folder attached to an email, preferably in a Zip folder.

I am new to VBA and self teaching so can understand how to change this code to my files but I am struggling to write the code to send only one email. I have attached the file I use to store the file paths - the top section is an example of the individual files and the bottom line is an example of a folder name we use.

Could you please have a look and offer any suggestions of the code that would do this for me?

Public Sub Send_Email_With_Multiple_Statements()

    Dim NSession As Object
    Dim NDb As Object
    Dim NDocument As Object
    Dim NRTItem As Object
    Dim SendToRecip As Variant
    Dim CopyToRecip As Variant
    Dim lastRow As Long, r As Long
    Dim UserName As String
    
    Set NSession = CreateObject("Notes.NotesSession")
    Set NDb = NSession.GetDatabase("", "")
    NDb.OPENMAIL
    
    lastRow = Cells(Rows.Count, "A").End(xlUp).Row

    For r = 2 To lastRow
        Set NDocument = NDb.CreateDocument
        With NDocument
            .Form = "Memo"
            .Subject = "Commission Statement"
            .sendto = Cells(r, "C").Value
            .copyto = Cells(r, "D").Value
            .body = "** In Confidence**" & vbLf & vbLf & _
                "Hello " & Cells(r, "A") & vbLf & vbLf & _
                "Please find attached your team's commission statements for " & Cells(r, "F") & vbLf & vbLf & _
                "If you are happy, please forward out to the individuals." & vbLf & vbLf & _
                "Please note: All queries need to be returned to me by COB on " & Cells(r, "G") & vbLf & vbLf & _
                "Kind regards,"
            
            If Dir(Cells(r, "E").Value) <> "" Then
                Set NRTItem = .CreateRichTextItem("Attachment")
                NRTItem.EmbedObject 1454, "", Cells(r, "E").Value
            Else
                MsgBox "File " & Cells(r, "E").Value & " doesn't exist so can't attach it to email."
            End If
            
            .SaveMessageOnSend = True
            .send False
        End With
    Next

    Set NSession = Nothing
    Set NDb = Nothing
    Set NDocument = Nothing
    Set NRTItem = Nothing

End Sub

Many thanks

 

[Dillon66]

Having trouble getting the example file to convert so I can attach a screen shot. Columns in the code explain the set up of the spread sheet I use. One option is to read multiple file names and send to one recipient email. The other option is one recipients email address and one folder path.

Hope you can help without the attachment.

Thanks