我如何使用Outlook将电子邮件发送给Excel中的多个收件人VBA
我试图在Excel表单上设置几个按钮来向不同的人群发送电子邮件。我在单独的工作表上创建了多个单元格范围,以列出单独的电子邮件地址。例如,我想要“按钮A”打开Outlook并将“工作表B:单元格D3-D6”中的电子邮件地址列表。然后,所有必须完成的操作都是在Outlook中点击“发送”。我如何使用Outlook将电子邮件发送给Excel中的多个收件人VBA
这是我的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 = "[email protected];[email protected]"
.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"
每一个细胞都环和构造您To
字符串。简单地将它分配给一个变体将无法解决目的。 EmailTo
如果您将范围直接指定给它,它将成为一个数组。你也可以这样做,但是你必须通过数组来创建你的To
字符串
这是你正在尝试的吗? (久经考验)
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 = "[email protected];[email protected]"
.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
不要忘了去工具 - >参考 - >微软Outlook对象库 – easycheese 2013-08-28 20:26:00
不,你不需要;)我使用晚绑定:) – 2013-08-30 08:50:20
不知道那是什么:)我只是跑陷入这个问题。 – easycheese 2013-09-04 00:09:46
ToAddress = "[email protected]"
ToAddress1 = "[email protected]"
ToAddress2 = "[email protected]"
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
你也可以使用[Recipient.Add](http://stackoverflow.com/questions/13019651/automated-email-generation-not-resolving-multiple-收件人) – SeanC 2013-02-20 17:05:37