如何从Excel通过Outlook向列表中的多个收件人发送电子邮件？

如果您的工作表某一列中有多个电子邮件地址，现在您希望直接从Excel向此收件人列表发送电子邮件而无需打开Outlook。本文将介绍如何同时从Excel向多个收件人发送电子邮件。

使用VBA代码从Excel向多个收件人发送电子邮件

使用VBA代码将当前工作簿作为附件发送电子邮件给多个收件人

使用VBA代码从Excel向多个收件人发送电子邮件

您可以使用VBA代码一次性向多个收件人发送消息，请按照以下步骤操作：

1. 按住 ALT + F11 键打开 Microsoft Visual Basic for Applications 窗口。

2. 单击 插入 > 模块，并将以下代码粘贴到 模块窗口中。

VBA代码：向多个收件人发送电子邮件

Sub sendmultiple()
'updateby Extendoffice
    Dim xOTApp As Object
    Dim xMItem As Object
    Dim xCell As Range
    Dim xRg As Range
    Dim xEmailAddr As String
    Dim xTxt As String
    On Error Resume Next
    xTxt = ActiveWindow.RangeSelection.Address
    Set xRg = Application.InputBox("Please select the addresses list:", "Kutools for Excel", xTxt, , , , , 8)
    If xRg Is Nothing Then Exit Sub
    Set xOTApp = CreateObject("Outlook.Application")
    For Each xCell In xRg
        If xCell.Value Like "*@*" Then
            If xEmailAddr = "" Then
                xEmailAddr = xCell.Value
            Else
                xEmailAddr = xEmailAddr & ";" & xCell.Value
            End If
        End If
    Next
    Set xMItem = xOTApp.CreateItem(0)
    With xMItem
        .To = xEmailAddr
        .Display
    End With
End Sub

3. 然后按 F5 键执行此代码，会弹出一个提示框提醒您选择地址列表，见截图：

4. 然后单击“确定”，将显示Outlook邮件窗口，您可以看到所有选定的电子邮件地址都已添加到“收件人”字段中，然后您可以输入主题并撰写您的邮件，见截图：

5. 完成邮件后，请单击“发送”按钮，此邮件将发送给您工作表列表中的这些收件人。

使用VBA代码将当前工作簿作为附件发送电子邮件给多个收件人

如果您需要将当前工作簿作为附件发送消息给多个收件人，可以应用以下VBA代码。

1. 按住 ALT + F11 键打开 Microsoft Visual Basic for Applications 窗口。

2. 单击 插入 > 模块，并将以下代码粘贴到模块窗口中。

VBA代码：将当前工作簿作为附件发送电子邮件给多个收件人

Sub EmailAttachmentRecipients()
'updateby Extendoffice
    Dim xOutlook As Object
    Dim xMailItem As Object
    Dim xRg As Range
    Dim xCell As Range
    Dim xEmailAddr As String
    Dim xTxt As String
    On Error Resume Next
    xTxt = ActiveWindow.RangeSelection.Address
    Set xRg = Application.InputBox("Please select the arresses list:", "Kutools for Excel", xTxt, , , , , 8)
    If xRg Is Nothing Then Exit Sub
    Set xOutlook = CreateObject("Outlook.Application")
    Set xMailItem = xOutlook.CreateItem(0)
    For Each xCell In xRg
        If xCell.Value Like "*@*" Then
            If xEmailAddr = "" Then
                xEmailAddr = xCell.Value
            Else
                xEmailAddr = xEmailAddr & ";" & xCell.Value
            End If
        End If
    Next
    With xMailItem
        .To = xEmailAddr
        .CC = ""
        .Subject = ""
        .Body = ""
        .Attachments.Add ActiveWorkbook.FullName
        .Display
    End With
    Set xOutlook = Nothing
    Set xMailItem = Nothing
End Sub

3. 粘贴代码后，按 F5 键运行此代码，会弹出一个提示框提醒您选择要发送消息的地址，见截图：

4. 然后单击 “确定”按钮，将显示Outlook 邮件窗口，所有电子邮件地址都已添加到“收件人”字段中，并且当前工作簿也已作为附件插入，然后您可以输入主题并撰写您的邮件，见截图：

5. 然后单击“发送”按钮，将此消息连同当前工作簿作为附件发送给收件人列表。

相关文章：

如何通过Outlook从Excel向列表发送个性化的群发邮件？