首页 文章

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

提问于
浏览 次
8

我正在尝试在Excel表单上设置几个按钮，以通过电子邮件发送给不同的人群 . 我在单独的工作表上创建了几个单元格范围，以列出单独的电子邮件地址 . 例如，我想要“按钮A”打开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
excel email vba outlook

2 回答

  • 13

    您必须遍历 "D3:D6" 范围内的每个单元格并构造 To 字符串 . 简单地将其分配给变体将无法解决目的 . 如果直接为其指定范围， EmailTo 将成为一个数组 . 您也可以这样做，但是您必须遍历数组以创建 To 字符串

    这是你在尝试什么？ （ TRIED AND TESTED ）

    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
    回复于
  • 2
    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
    回复于

相关问题