从 Excel 文件发送具有多个收件人的 Outlook 电子邮件答案

【问题标题】：Sending Outlook Email with multiple recipients from Excel file从 Excel 文件发送具有多个收件人的 Outlook 电子邮件
【发布时间】：2018-04-16 00:20:09
【问题描述】：

我目前正在做一个 VBA 宏，它将发送一封具有以下条件的 Outlook 电子邮件：

A.收件人列在 Sheet1 的 D 列中，我想要的只是在 Outlook 的 TO 字段中连接每个发件人。但是，这些接收者是动态的，并且在数量上可能不同。案例可能会导致在这些列中添加或减少电子邮件地址。

B.我需要将 Sheet2 的任何内容粘贴到 Outlook 的 BODY 字段中。 C. 我需要生成一封带有签名的电子邮件。

到目前为止，我有这段代码，但它不起作用：

Option Explicit

Sub SendEmail()

Dim OutlookApplication As Outlook.Application
Dim OutlookMailItem As Outlook.MailItem
Dim outlookInspector As Outlook.Inspector
Dim wdDoc As Word.Document
Dim Recipient As Range
Dim CC As Range

Application.ScreenUpdating = False

Set OutlookApplication = New Outlook.Application
Set OutlookMailItem = OutlookApplication.CreateItem(0)

'On Error GoTo cleanup

    Workbooks("ConfigFile.xlsm").Sheets("Sheet1").Activate

    Range("D2").Select
    Set Recipient = Range(ActiveCell, ActiveCell.End(xlDown))

    Range("E2").Select
    Set CC = Range(ActiveCell, ActiveCell.End(xlDown))

    With OutlookMailItem
        .Display
        .To = Recipient
        .CC = CC
        .subject = ThisWorkbook.Sheets("Sheet1").Range("F2").Value
        .Body = ThisWorkbook.Sheets("Sheet1").Range("G2").Value

        Set outlookInspector = .GetInspector
        Set wdDoc = outlookInspector.WordEditor

        wdDoc.Range.InsertBreak

        Sheet2.Activate
        Range("A:A").CurrentRegion.Copy

        wdDoc.Range.Paste

    End With


'cleanup:
    'Set OutlookApplication = Nothing
    'Application.ScreenUpdating = True

End Sub

【问题讨论】：

什么不起作用？它会抛出错误吗？在哪一行？
我认为 With OutlookMailItem 中的所有内容都不起作用。我不知道修复错误的正确代码组合是什么。它说“运行时错误 13”。
发生错误时哪一行被高亮显示？
.to = 收件人的字段

标签： vba excel email outlook

【解决方案1】：

要回答您问题的第一部分，请将.To 和.CC 替换为：

Dim myDelegate As Outlook.Recipient

    For Each sTo In Recipient
        Set myDelegate = OutlookMailItem.Recipients.Add(sTo)
        myDelegate.Resolve
        If Not myDelegate.Resolved Then
            myDelegate.Delete
        End If
    Next sTo

    For Each sTo In CC
        Set myDelegate = OutlookMailItem.Recipients.Add(sTo)
        myDelegate.Type = olCC
        myDelegate.Resolve
        If Not myDelegate.Resolved Then
            myDelegate.Delete
        End If
    Next sTo

这会遍历您在 D 和 E 列中的每个人，并将他们输入到相关字段中，如果有人不存在，它将删除该人，如果您不希望发生这种情况，只需删除上面每个循环中的If 语句

您的其他 2 个问题应单独提出，但通过 Google 快速搜索发现可能对您有所帮助的类似问题

For pasting data from Excel to Outlook Body

For Email signature

.To 和.CC 用的什么来回答你的问题，你可能想看看它们，它们将来可能会对你有所帮助

【讨论】：

只是为了确认：我只会更改 With outlookmailitem 中的 ,to 和 ,cc 值？对吗？
是的，.To 替换为第一个循环，.CC 替换为第二个循环@RouellaMayGabineteAmponin

【解决方案2】：

我通过将所有这些单独的收件人添加到一个字符串来解决这个问题。逐个单元格获取它们并将它们添加到字符串中，并提供“;”在需要的地方:)

不知道它是否适用于范围。我认为这是问题所在。

希望对你有帮助！

【讨论】：

嗨！你能告诉我你的意思吗。我只是 VBA 的新手，在代码操作方面仍然不是专家。提前致谢。
如果只是添加一个范围的收件人，可能没有“;” （以分隔不同的收件人）。另外我不知道.to 是否可以处理一个范围。我以为它要求输入字符串。所以我会创建一个字符串，获取每个单元格的值并将其保存在该字符串中，并结合“;”在每个收件人之间。可能有用（对我有用）。