Send E-mail from cell values using VBA

[crzytimes]

Hey!

I'm looking for some assistance in getting me in the right direction. I would like to automate e-mailing multiple vendors from a spreadsheet I would export from SAP and touch up. It would look something like this table. I want to get the rows for each vendor into the email body addressed just to that vendor, without sending multiple e-mails to the same vendor.

Is this type of automation possible with VBA code?

Material	Description	QTY	Vendor	Release Date	Contact	E-mail Address
partnumberA	screw A	100	vendor A	5/15/2017	Jon	vendorA@vendorA.com
partnumberB	screw B	100	vendor B	5/15/2017	Randy	vendorB@vendorB.com
partnumberC	screw C	100	vendor C	5/17/2017	Bob	vendorC@vendorC.com
partnumberCC	screw D	100	vendor C	5/17/2017	Bob	vendorC@vendorC.com
partnumberCCC	screw E	100	vendor C	5/17/2017	Bob	vendorC@vendorC.com
partnumberD	screw F	100	vendor D	5/15/2017	Sarah	vendorD@vendorD.com
partnumberE	screw G	100	vendor E	5/16/2017	Clara	vendorE@vendorE.com
partnumberE	screw H	100	vendor E	5/16/2017	Clara	vendorE@vendorE.com

<tbody>
</tbody>

 

[daverunt]

Hi ,

I did something similar here, should get you started. You'll need to change the email address column and the 'yes' to sent mails column.

https://www.mrexcel.com/forum/excel-questions/680327-macro-send-email-through-outlook-3.html

 

[daverunt]

Hi,

Modified my code and created a table for the mail body: It works with your example table.

Sub Send_Table()

'Set email address as range for first loop to run down
 Set rng = Range(Range("G2"), Range("G" & Rows.Count).End(xlUp))
          
'Get a row count to clear column H at the end
  x = rng.Rows.Count
 
'Create the html table and header from the first row
    tableHdr = "<table border=1><tr><th>" & Range("A1").Value & "</th>" _
            & "<th>" & Range("B1").Value & "</th>" _
            & "<th>" & Range("C1").Value & "</th>" _
            & "<th>" & Range("D1").Value & "</th>" _
            & "<th>" & Range("E1").Value & "</th>" _
            & "<th>" & Range("F1").Value & "</th>" _

'Check to see if column H = 'yes' and skip mail if it does
    For Each cell In rng
    If cell.Value <> "" Then
    If Not cell.Offset(0, 1).Value = "yes" Then

        
    NmeRow = cell.Row

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.createitem(0)

    MailTo = cell.Value 'column G
    MailSubject = cell.Offset(0, -3).Value 'column D
    
'Create MailBody table row for first row
    MailBody = "<tr>" _
            & "<td>" & cell.Offset(0, -6).Value & "</td>" _
            & "<td>" & cell.Offset(0, -5).Value & "</td>" _
            & "<td>" & cell.Offset(0, -4).Value & "</td>" _
            & "<td>" & cell.Offset(0, -3).Value & "</td>" _
            & "<td>" & cell.Offset(0, -2).Value & "</td>" _
            & "<td>" & cell.Offset(0, -1).Value & "</td>" _
            & "</tr>"

'Second loop checks the email addresses of all cells following the current cell in the first loop.
'Yes will be appended on any duplicate finds and another row added to the mailbody table
    For Each dwn In rng.Offset(NmeRow - 1, 0)


 
    If dwn.Value = cell.Value Then

'Create additional table row for each extra row found
    AddRow = "<tr>" _
            & "<td>" & dwn.Offset(0, -6).Value & "</td>" _
            & "<td>" & dwn.Offset(0, -5).Value & "</td>" _
            & "<td>" & dwn.Offset(0, -4).Value & "</td>" _
            & "<td>" & dwn.Offset(0, -3).Value & "</td>" _
            & "<td>" & dwn.Offset(0, -2).Value & "</td>" _
            & "<td>" & dwn.Offset(0, -1).Value & "</td>" _
            & "</tr>"

    dwn.Offset(0, 1).Value = "yes"
    MailBody = MailBody & AddRow  'column A

    End If
' Clear additional table row variable ready for next
    AddRow = ""
    Next
        With OutMail
            .To = MailTo
            .Subject = MailSubject
            .HTMLBody = tableHdr & MailBody & "</table>"
            .Display
        'send
       End With
        
    cell.Offset(0, 1).Value = "yes"
  
  End If
 End If
 
 
MailTo = ""
MailSubject = ""
MailBody = ""
Next

'Clear 'yes' from all appended cells in column H
 Range("H2:H" & x).ClearContents
End Sub

 

[crzytimes]

Thank you You've done too much! I'll be able to adjust from here.

This is awesome!

 

[daverunt]

My pleasure.