在Excel VBA中自动化邮件合并——不要发送多个邮件。

时间：2023-01-15 13:23:09

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.

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

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.

我很难让代码发送超过一个电子邮件，因为在选择一个范围5行和电子邮件客户端只发送一个电子邮件。

Does anyone have any direction they could lend?

有没有人可以借钱给他们?

Thanks everyone for solving this!

谢谢大家解决这个问题!

1 个解决方案

#1

0  

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

#1

0  

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
标签：

相关文章