Question

我目前正在做一个VBA-macro，它会发送一封包含以下标准的SINGLE Outlook电子邮件：

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

B中。我需要在outlook的BODY字段中粘贴Sheet2的任何内容。 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

Answer 1

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

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

希望它有所帮助！

Answer 2

要回答问题的第一部分，请替换.To＆amp; .CC with：

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＆amp; D列中的每个人。 E并将它们输入到相关字段中，如果某人不存在，它将删除该人，如果您不希望这种情况发生，只需删除上面每个循环中的If语句< / p>

您应该单独询问您的其他两个问题，但快速Google搜索会找到类似的问题，这可能会对您有所帮助

For pasting data from Excel to Outlook Body

For Email signature

我用于.To＆amp; .CC要回答您的问题，您可能需要查看这些问题，以后可能会对您有所帮助

使用Excel文件中的多个收件人发送Outlook电子邮件

2 个答案: