Mail merge multiple data rows to one email address

[stebrownsword]

Email	Data
Ste@google.com	1
ste@google.com	2
Bob@google.com	A
Bob@google.com	B

<tbody>
</tbody>

Hi guys

is there a way that I can mail merge 1 email with several rows of data, instead on several emails with 1 row of data?

desired result - Ste recieves 1 email which states 1+2 and bob recieves an email which states A+B

at the moment - Ste recieves 2 emails 1 email stating 1 the other email statin 2 , Bob recieves 2 emails 1 email wth A another email with B

 

[daverunt]

It would need adapting but here's something I did previously to create an HTML table with rows for each mail address in a column.
It uses 2 loops to add a new row for each row with a repeat address.

It adds a 'yes' to a cell to prevent another mail generation if re-run.
You could remove that.

Might be long-winded but it works if nothing better comes your way.

https://www.mrexcel.com/forum/excel-questions/1004920-send-e-mail-cell-values-using-vba.html

 

[stebrownsword]

thank you, I will give it a go

 

[daverunt]

Hi,

refreshing my memory with my own code... Because the original post had email addresses in non-consecutive rows that was the reason for appending 'yes' in a blank column so it was ignored on any second pass.
the macro removes the 'yes' once all emails are created. So you might want to leave it in.

 

[stebrownsword]

quick question - where and how could I add Text within the email to go above the table to state "please find the table below"

also how what code would be needed so the document auto emails instead of only creating the email?

thanks in advance, I'm about to drive and finish for the week, so can't test till Monday but thankyou very much

 

[daverunt]

Hi,

Assuming you use the macro code on the link: Add it between the lines shown. (Without spaces in the HTML 'p' tags)
Perhaps it would make sense to also change the name MailBody to TableBody as the body content is no longer just a table. For clarity.

 MailSubject = cell.Offset(0, 1).Value 'column B
    
    
    TextBody = "< p >Hi< /p >" _
                  & "< p >please find the table below< /p >"
    
'Create MailBody table row for first row


Add TextBody here and to send it without displaying just comment out .Display and uncomment out .Send
.HTMLBody = TextBody & tableHdr & MailBody & "</table>"
        '.Display
        .Send

 

[stebrownsword]

thank you, I will try it this afternoon

 

[stebrownsword]

this goes over my head sorry

Where exactly should I copy this?

1.
2. MailSubject = cell.Offset(0, 1).Value 'columnB
3.
4.
5. TextBody = "< p >Hi</p >" _
6. & "<p >please find the table below< /p >"
7.
8. 'CreateMailBody table row for first row
9.
10.
11. AddTextBody here and to send it without displaying just comment out .Display anduncomment out .Send
12. .HTMLBody= TextBody & tableHdr & MailBody & "</table>"
13. '.Display
14. .Send
​

Into

1. SubSend_Table()
2.
3. 'Setemail address as range for first loop to run down
4. Set rng = Range(Range("G2"),Range("G" & Rows.Count).End(xlUp))
5.
6. 'Geta row count to clear column H at the end
7. x = rng.Rows.Count
8.
9. 'Createthe html table and header from the first row
10. tableHdr = "<tableborder=1><tr><th>" &Range("A1").Value & "</th>"_
11. & "<th>"& Range("B1").Value & "</th>"_
12. & "<th>"& Range("C1").Value & "</th>"_
13. & "<th>"& Range("D1").Value & "</th>"_
14. & "<th>"& Range("E1").Value & "</th>"_
15. & "<th>"& Range("F1").Value & "</th>"_
16.
17. 'Checkto see if column H = 'yes' and skip mail if it does
18. For Each cell In rng
19. If cell.Value <> "" Then
20. If Not cell.Offset(0, 1).Value ="yes" Then
21.
22.
23. NmeRow = cell.Row
24.
25. Set OutApp =CreateObject("Outlook.Application")
26. Set OutMail = OutApp.createitem(0)
27.
28. MailTo = cell.Value 'column G
29. MailSubject = cell.Offset(0, -3).Value'column D
30.
31. 'CreateMailBody table row for first row
32. MailBody = "<tr>"_
33. & "<td>"& cell.Offset(0, -6).Value & "</td>"_
34. & "<td>"& cell.Offset(0, -5).Value & "</td>"_
35. & "<td>"& cell.Offset(0, -4).Value & "</td>"_
36. & "<td>"& cell.Offset(0, -3).Value & "</td>"_
37. & "<td>"& cell.Offset(0, -2).Value & "</td>"_
38. & "<td>"& cell.Offset(0, -1).Value & "</td>"_
39. & "</tr>"
40.
41. 'Secondloop checks the email addresses of all cells following the current cell in thefirst loop.
42. 'Yeswill be appended on any duplicate finds and another row added to the mailbodytable
43. For Each dwn In rng.Offset(NmeRow - 1, 0)
44.
45.
46.
47. If dwn.Value = cell.Value Then
48.
49. 'Createadditional table row for each extra row found
50. AddRow = "<tr>"_
51. & "<td>"& dwn.Offset(0, -6).Value & "</td>"_
52. & "<td>"& dwn.Offset(0, -5).Value & "</td>"_
53. & "<td>"& dwn.Offset(0, -4).Value & "</td>"_
54. & "<td>"& dwn.Offset(0, -3).Value & "</td>"_
55. & "<td>"& dwn.Offset(0, -2).Value & "</td>"_
56. & "<td>"& dwn.Offset(0, -1).Value & "</td>"_
57. & "</tr>"
58.
59. dwn.Offset(0, 1).Value = "yes"
60. MailBody = MailBody & AddRow 'column A
61.
62. End If
63. 'Clear additional table row variable ready for next
64. AddRow = ""
65. Next
66. With OutMail
67. .To = MailTo
68. .Subject = MailSubject
69. .HTMLBody = tableHdr & MailBody& "</table>"
70. .Display
71. 'send
72. End With
73.
74. cell.Offset(0, 1).Value = "yes"
75.
76. End If
77. End If
78.
79.
80. MailTo= ""
81. MailSubject= ""
82. MailBody= ""
83. Next
84.
85. 'Clear'yes' from all appended cells in column H
86. Range("H2:H" & x).ClearContents
​

End Sub

 

[daverunt]

The HTML rendering here can be 'dubious' so here's the code in a text file with the required bits added/modified

https://drive.google.com/open?id=1Qoaxx9GNm-ScTGN9TkUnehesavMz_neR

 

[stebrownsword]

Run Time - Error 424: Object Required

I just copied and pasted your link, it stated the above?


I admire your skills, because your coding goes over my head, I'm good at formulas but clueless at VBA