VBA - 向未知数量的收件人发送 Outlook 电子邮件答案

【问题标题】：VBA - Sending an Outlook Email to unknown number of recipientsVBA - 向未知数量的收件人发送 Outlook 电子邮件
【发布时间】：2023-03-22 04:30:01
【问题描述】：

大约一个月前，我已经发布了一个与我当前的问题有些相似的问题。

Sending Outlook Email with multiple recipients from Excel file

但是今天，我想开发不关心 TO 字段是否仅包含 1 个收件人以及 CC 可能为 EMPTY 的代码。我能够想出这两种类型的代码：

   'Set Recipients
    Range("A2").Select
        Set Recipient = Range(ActiveCell, ActiveCell.End(xlDown))

    'Set Recipients
    Range("B2").Select
        Set CC = Range(ActiveCell, ActiveCell.End(xlDown))


    On Error Resume Next

        With OutlookMailItem

            .Display

            'Assign Recipients in TO field
            For Each sTo In Recipient
                Set myRecipient = OutlookMailItem.Recipients.Add(sTo)
                myRecipient.Type = olTo
                myRecipient.Resolve
                If Not myRecipient.Resolved Then
                    myRecipient.Delete
                End If
            Next sTo

            'Assign CCs in CC field
            For Each sCc In CC
                Set myCc = OutlookMailItem.Recipients.Add(sCc)
                myCc.Type = olCC
                myCc.Resolve
                If Not myCc.Resolved Then
                    myCc.Delete
                End If
            Next sCc
        End With

但是，这些代码仅适用于两个或更多电子邮件地址。当我尝试只为 TO 提供 1 个值而为 CC 不提供值时，它显示运行时错误“-2147352567 (80020009)”：在“收件人”、“抄送”或“密件抄送”框中必须至少有一个姓名或联系人组。

For Each sTo in Recipients
    receiver = receiver & sTo.Value & ";"
Next

For Each sCc in CC
    CCs = CCs & sCc.Value & ";"
Next

但这些代码会导致 Excel 文件无响应。

我的代码有错误吗？或者关于如何使我的 TO 和 CC 字段动态化的任何建议。从某种意义上说是动态的，我可以为 TO 分配 ONE 或 MORE，为 CC 分配 NONE 或 MORE。

【问题讨论】：

标签： vba excel

【解决方案1】：

可能是这样的（未经测试）

Dim rngTo As Range, rngCC As Range

With ActiveSheet
    'using xlUp is typically safer than xlDown...
    Set rngTo = .Range(.Range("A2"), .Cells(.Rows.Count, 1).End(xlUp))
    Set rngCC = .Range(.Range("B2"), .Cells(.Rows.Count, 2).End(xlUp))
End With

AddRecipients OutlookMailItem, rngTo, olTo
AddRecipients OutlookMailItem, rngCC, olCC

由于有很多通用代码，您可以创建一个子程序来处理添加收件人：

Sub AddRecipients(olMail, rng As Range, recipType)
    Dim c As Range, myRecipient
    For Each c In rng.Cells
        If c.Value <> "" Then
            Set myRecipient = olMail.Recipients.Add(c.Value)
            myRecipient.Type = recipType
            myRecipient.Resolve
            If Not myRecipient.Resolved Then myRecipient.Delete
        End If
    Next c
End Sub

【讨论】：

“不工作”不是对运行代码时发生的情况的有用描述。究竟是什么问题？

【解决方案2】：

您的代码中的问题是，在零个或一个收件人（或 CC）的情况下，您的 Recipient 变量几乎包含整个列。对于代码 A，问题在于有许多空单元格并循环通过它们会导致 There must be at least one name or contact group in the To, Cc, or Bcc box 错误。对于代码 B，我猜循环遍历 1 048 576 行（两次！）对于 excel 来说有点太多了。

【讨论】：