如何使用Excel中存储的多个收件人地址发送电子邮件?

13

我正试图在Excel表单上设置多个按钮,以向不同的人群发送电子邮件。
我在另一个工作表上创建了几个单元格范围,用于列出电子邮件地址。

例如,我希望“按钮A”打开Outlook,并将来自“工作表B:单元格D3-D6”的电子邮件地址列表放入电子邮件中。然后只需要在Outlook中点击“发送”即可。

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

你可以使用Recipient.Add - SeanC
3个回答

20

您必须循环遍历范围内的每个单元格 "D3:D6" 并构造您的To字符串。仅将其分配给变量将无法解决问题。如果您直接将范围分配给EmailTo,则它将变成一个数组。您也可以这样做,但然后您将不得不遍历数组以创建To字符串。

CODE

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

不要忘记前往工具-->引用-->Microsoft Outlook对象库。 - easycheese
1
不需要那个 ;) 我正在使用后期绑定 :) - Siddharth Rout
我不知道那是什么 :) 我只是遇到了这个问题。 - easycheese
4
在谷歌上搜索“Latebinding vs Earlybinding”即可了解晚期绑定与早期绑定的区别。 - Siddharth Rout
7
完全没有理由去构建一个用 ";" 分隔的字符串 - 只需为每个收件人调用 MailItem.Recipients.Add 方法即可。 - Dmitry Streblechenko

5
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

1
与其他答案不同,此示例使用Recipients.Add方法,正如文档所推荐的那样。 - ashleedawg

0

两个答案都是正确的。 如果您使用 .TO 方法,则分号是可以的,但对于 addrecipients 方法则不行。在那里,您需要进行拆分,例如:

                Dim Splitter() As String
                Splitter = Split(AddrMail, ";")
                For Each Dest In Splitter
                    .Recipients.Add (Trim(Dest))
                Next

网页内容由stack overflow 提供, 点击上面的
可以查看英文原文,
原文链接