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

Posted 2023-03-15

【中文标题】如何使用存储在 Excel 中的地址向多个收件人发送电子邮件？

【英文标题】：How to send email to multiple recipients with addresses stored in Excel?

【发布时间】：2013-02-05 18:33:59

【问题描述】：

我正在尝试在 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 = "[e-mail];[e-mail]" 
        .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

【参考方案1】：

您必须遍历"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 = "[e-mail];[e-mail]"
        .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 对象库

不，你不需要那个 ;) 我正在使用后期装订 :)

不知道那是什么 :) 我刚刚遇到了这个问题。

在 Google 上搜索后期绑定与早期绑定；）

绝对没有理由建立一个“;”分隔到字符串 - 只需为每个收件人调用 MailItem.Recipients.Add。

【参考方案2】：

ToAddress = "[e-mail]"
ToAddress1 = "[e-mail]"
ToAddress2 = "[e-mail]"
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

【讨论】：

与其他答案不同，此示例使用Recipients.Add 方法，按照documentation 的建议。

【参考方案3】：

两个答案都是正确的。 如果您使用 .TO -method，则分列是可以的 - 但对于 addrecipients-method，不是。在那里你需要分裂，例如：

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