Question

这是一个自动邮件合并，我从几个不同的网站拼凑而成。

多次更改以确保发送的电子邮件是HTML并包含默认用户签名。

单击按钮后，会弹出一个窗口以选择范围，然后根据范围选择对电子邮件进行个性化。

           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

我无法让代码发送多封电子邮件，因为在选择5行的范围内，电子邮件客户端只会发送一封电子邮件。

有没有人有任何可以借出的方向？

感谢大家解决这个问题！

Answer 1

在我看来，好像你没有把电子邮件放在循环中。

For i = 1 To xRg.rows.Count
<<put email composing code here>>
Next I

在Excel VBA中自动化邮件合并 - 不发送多封电子邮件

1 个答案: