如何使用Outlook将电子邮件发送给Excel VBA中的多个收件人

我正试图在Excel表单上设置几个button来向不同的人群发送电子邮件。 我在单独的工作表上创build了几个单元格范围来列出单独的电子邮件地址。 例如,我想要“buttonA”打开Outlook,并将“工作表B:单元格D3-D6”中的电子邮件地址列表。 然后,所有必须做的是在Outlook中点击“发送”。

这是我的VBA代码到目前为止,但我无法得到它的工作。 有人能告诉我我错过了什么,或者错了吗?

VB:

Sub Mail_workbook_Outlook_1() 'Working in 2000-2010 'This example send the last saved version of the Activeworkbook Dim OutApp As Object Dim OutMail As Object EmailTo = Worksheets("Selections").Range("D3:D6") Set OutApp = CreateObject("Outlook.Application") Set OutMail = OutApp.CreateItem(0) On Error Resume Next With OutMail .To = EmailTo .CC = "person1@email.com;person2@email.com" .BCC = "" .Subject = "RMA #" & Worksheets("RMA").Range("E1") .Body = "Attached to this email is RMA #" & Worksheets("RMA").Range("E1") & ". Please follow the instructions for your department included in this form." .Attachments.Add ActiveWorkbook.FullName 'You can add other files also like this '.Attachments.Add ("C:\test.txt") .Display End With On Error Goto 0 Set OutMail = Nothing Set OutApp = Nothing End Sub 

您必须遍历范围"D3:D6"中的每个单元格,并构造您的Tostring。 简单地将它分配给一个变体不会解决这个目的。 如果您将范围直接指定给它, EmailTo将成为一个数组。 你也可以这样做,但是你将不得不遍历数组来创buildTostring

这是你正在尝试? ( 试验和testing

 Option Explicit Sub Mail_workbook_Outlook_1() 'Working in 2000-2010 'This example send the last saved version of the Activeworkbook Dim OutApp As Object Dim OutMail As Object Dim emailRng As Range, cl As Range Dim sTo As String Set emailRng = Worksheets("Selections").Range("D3:D6") For Each cl In emailRng sTo = sTo & ";" & cl.Value Next sTo = Mid(sTo, 2) Set OutApp = CreateObject("Outlook.Application") Set OutMail = OutApp.CreateItem(0) On Error Resume Next With OutMail .To = sTo .CC = "person1@email.com;person2@email.com" .BCC = "" .Subject = "RMA #" & Worksheets("RMA").Range("E1") .Body = "Attached to this email is RMA #" & _ Worksheets("RMA").Range("E1") & _ ". Please follow the instructions for your department included in this form." .Attachments.Add ActiveWorkbook.FullName 'You can add other files also like this '.Attachments.Add ("C:\test.txt") .Display End With On Error GoTo 0 Set OutMail = Nothing Set OutApp = Nothing End Sub 
 ToAddress = "test@test.com" ToAddress1 = "test1@test.com" ToAddress2 = "test@test.com" MessageSubject = "It works!." Set ol = CreateObject("Outlook.Application") Set newMail = ol.CreateItem(olMailItem) newMail.Subject = MessageSubject newMail.RecipIents.Add(ToAddress) newMail.RecipIents.Add(ToAddress1) newMail.RecipIents.Add(ToAddress2) newMail.Send