Automate Mail merge in Excel VBA - Not sending multiple emails
Question
This is an automated mail merge that I pieced together from a few different sites.
It's been altered many times to make sure the email that sends is HTML and includes the default users signature.
After button click, a window pops up to select a range, the email is then personalised depending on the range selection.
Sub EmailAttachmentRecipients()
'updateby Extendoffice 20160506
Dim xOutlook As Object
Dim xMailItem As Object
Dim xRg As Range
Dim xCell As Range
Dim xTxt As String
Dim Signature As String
Dim xEmail As String
Dim xSubj As String
Dim xMsg As String
Dim i As Integer
Dim k As Double
' Create window to select range
xTxt = ActiveWindow.RangeSelection.address
Set xRg = Application.InputBox("Please select the arresses list:", "Water Corporation Mail Merge", xTxt, , , , , 8)
If xRg Is Nothing Then Exit Sub
For i = 1 To xRg.rows.Count
Set xOutlook = CreateObject("Outlook.Application")
Set xMailItem = xOutlook.CreateItem(0)
xMsg = "<BODY style=font-size:11pt;font-family:Verdana>" & Sheet2.Cells(4, 2) & " " & xRg.Cells(i, 1) & ",</BODY>" & "<br>"
xMsg = xMsg & "" & Sheet2.Cells(6, 2) & " " & Sheet2.Cells(6, 4) & " " & Sheet2.Cells(6, 6) & " " & "<br>" & "<br>"
xMsg = xMsg & "" & Sheet2.Cells(8, 2) & " " & "<br>" & "<br>"
xMsg = xMsg & "" & Sheet2.Cells(10, 2) & "" & "<br>"
xEmail = xRg.Cells(i, 2)
With xMailItem
.Display
.To = xEmail
.CC = ""
.Subject = "" & Sheet2.Cells(2, 2) & " " & xRg.Cells(i, 3) & " - " & xRg.Cells(i, 4) & ""
.HTMLBody = xMsg & .HTMLBody
.Send
End With
Set xOutlook = Nothing
Set xMailItem = Nothing
Next i
End Sub
I'm having trouble getting the code to send more than one email, as in select a range of 5 rows and the email client only sends off one email.
Does anyone have any direction they could lend?
Thanks everyone for solving this!
1 answers
solution1
0 2017-04-07 06:02:34
It looks to me as though you aren't putting the compose email in the loop.
For i = 1 To xRg.rows.Count
<<put email composing code here>>
Next I
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.