VBA – 将Outlook电子邮件发送给未知数量的收件人
差不多一个月前，我已经发表了一个与我目前这个问题有点相似的问题。
从Excel文件发送多个收件人的Outlook电子邮件
但是今天，我想开发不关心TO字段是否只包含1个收件人的代码，并且可能对于CC而言是EMPTY。 我能够拿出这两种types的代码：
一个。
'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）'：收件人，抄送员或密件抄送框中必须至less有一个姓名或联系人组。
B.
For Each sTo in Recipients receiver = receiver & sTo.Value & ";" Next For Each sCc in CC CCs = CCs & sCc.Value & ";" Next
但是这些代码会导致无响应的Excel文件。
我的代码有错误吗？ 或者有关如何使我的TO和CC字段变为dynamic的任何build议。 从某种意义上来说，dynamic是我可以为CC分配一个或多个TO和NONE或更多。
这样的事情可能（未经testing）
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
由于有很多通用代码，您可以创build一个子处理添加收件人：
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
代码中的问题是，如果零个或一个收件人（或CC） Recipientvariables包含几乎整个列。 对于代码A，问题是存在许多空单元，并且循环遍历它们。结果There must be at least one name or contact group in the To, Cc, or Bcc box错误。 对于代码B，我想循环1 048 576行（两次！）对于excel来说有点太过分了。