Send multiple mails to multiple persons with multiple attachments [closed]

Question

As the title says, I would like to send multiple emails to different mail adreses, with multiple attachments on each mail.

The better would be to be able to have dynamic mail subject and dynamic mail body also that change for each different mails.

I already prepared an excel file with an example of the list I got, list of email related to the person I want to send mails to and finally a small tab with what the settings should be in Excel.

Then, at the end it’s a example of a mail I want Excel to prepare when I run the macro (the example mail does not have any attachments but the mail that I want should have the attachments on it).

Feel free to add step, or change anything in the format of Data example and Details example, but the format of Example can’t be change.

Obviously, all the data here are anonymized.

Thanks a lot !

Data example

Example

Details Example

Email example

I already tried this VBA macro but it does not allow me to add multiple attachment.

Sub sendEmailsWithHTMLTables()

    Dim objOutlook As Object
    Set objOutlook = CreateObject("Outlook.Application")
    
    strSubject = "Latest Data"
    strBody = "<html>"
    
    strBody = strBody & "Hi All<br><br>"
    strBody = strBody & "Please find the latest data given below<br>"
    
    strTable = "<br><table border=2><tbody>"
    strTable = strTable & "<tr>"
    strTable = strTable & "<th align=center>Item Name</th>"
    strTable = strTable & "<th align=center>Quantity</th>"
    strTable = strTable & "<th align=center>Cost Per Unit</th>"
    strTable = strTable & "<th align=center>Total Cost</th>"
    strTable = strTable & "</tr>"
    
    intRows = ThisWorkbook.Sheets("Data").Cells(Rows.Count, 1).End(xlUp).Row
    For intRowNo = 2 To intRows
                    
        strItemName = Trim(ThisWorkbook.Sheets("Data").Range("B" & intRowNo).Text)
        strQuantity = Trim(ThisWorkbook.Sheets("Data").Range("C" & intRowNo).Text)
        strCostPerUnit = Trim(ThisWorkbook.Sheets("Data").Range("D" & intRowNo).Text)
        strTotalCost = Trim(ThisWorkbook.Sheets("Data").Range("E" & intRowNo).Text)

        strTable = strTable & "<tr><td>" & strItemName & "</td>"
        strTable = strTable & "<td>" & strQuantity & "</td>"
        strTable = strTable & "<td>" & strCostPerUnit & "</td>"
        strTable = strTable & "<td>" & strTotalCost & "</td></tr>"
             
    Next
    
    strTable = strTable & "</tbody></table><br>"
    strBody1 = "<br>Regards<br>"
    strBody1 = strBody1 & "AAAAA<br>"
    
    strHTML = strBody & strTable & strBody1 & "</html>"
    
    Set objEmail = objOutlook.CreateItem(olMailItem)
    With objEmail
        .To = "validEmailID"
        .Subject = strSubject
        .htmlBody = strHTML
        .Send
    End With
    
End Sub

Thanks !

Leave a Comment Cancel reply