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?



[TABLE="class: grid, width: 1000"]
<tbody>[TR]
[TD]Material[/TD]
[TD]Description[/TD]
[TD]QTY[/TD]
[TD]Vendor[/TD]
[TD]Release Date[/TD]
[TD]Contact[/TD]
[TD]E-mail Address[/TD]
[/TR]
[TR]
[TD]partnumberA[/TD]
[TD]screw A[/TD]
[TD]100[/TD]
[TD]vendor A[/TD]
[TD]5/15/2017[/TD]
[TD]Jon[/TD]
[TD]vendorA@vendorA.com[/TD]
[/TR]
[TR]
[TD]partnumberB[/TD]
[TD]screw B[/TD]
[TD]100[/TD]
[TD]vendor B[/TD]
[TD]5/15/2017[/TD]
[TD]Randy[/TD]
[TD]vendorB@vendorB.com[/TD]
[/TR]
[TR]
[TD]partnumberC[/TD]
[TD]screw C[/TD]
[TD]100[/TD]
[TD]vendor C[/TD]
[TD]5/17/2017[/TD]
[TD]Bob[/TD]
[TD]vendorC@vendorC.com[/TD]
[/TR]
[TR]
[TD]partnumberCC[/TD]
[TD]screw D[/TD]
[TD]100[/TD]
[TD]vendor C[/TD]
[TD]5/17/2017[/TD]
[TD]Bob[/TD]
[TD]vendorC@vendorC.com[/TD]
[/TR]
[TR]
[TD]partnumberCCC[/TD]
[TD]screw E[/TD]
[TD]100[/TD]
[TD]vendor C[/TD]
[TD]5/17/2017[/TD]
[TD]Bob[/TD]
[TD]vendorC@vendorC.com[/TD]
[/TR]
[TR]
[TD]partnumberD[/TD]
[TD]screw F[/TD]
[TD]100[/TD]
[TD]vendor D[/TD]
[TD]5/15/2017[/TD]
[TD]Sarah[/TD]
[TD]vendorD@vendorD.com[/TD]
[/TR]
[TR]
[TD]partnumberE[/TD]
[TD]screw G[/TD]
[TD]100[/TD]
[TD]vendor E[/TD]
[TD]5/16/2017[/TD]
[TD]Clara[/TD]
[TD]vendorE@vendorE.com[/TD]
[/TR]
[TR]
[TD]partnumberE[/TD]
[TD]screw H[/TD]
[TD]100[/TD]
[TD]vendor E[/TD]
[TD]5/16/2017[/TD]
[TD]Clara[/TD]
[TD]vendorE@vendorE.com[/TD]
[/TR]
</tbody>[/TABLE]

 

[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.