Outlook VBA 中的错误循环通过收件人

Question

我有一个 Excel 表，范围 A1:B7 中有以下值

+----------------+--------------------+
| Recipient Type | Recipient Addresss |
+----------------+--------------------+
| To             | a@xyz.com          |
| To             | b@xyz.com          |
| CC             | c@xyz.com          |
| CC             | d@xyz.com          |
| BCC            | e@xyz.com          |
| BCC            | f@xyz.com          |
+----------------+--------------------+

然后我制作了以下 VBA 宏以将这些添加为 Outlook 中的电子邮件收件人

Option Explicit

Sub Add_Recipients_Data_and_Type()
Dim olApp As Outlook.Application
Set olApp = GetObject(, "Outlook.Application")
Dim olMail As Outlook.MailItem
Set olMail = olApp.CreateItem(olMailItem)
olMail.Display
Dim rn As Range
Dim cl As Range
Dim i As Long
i = 1
Set rn = Range("A1").CurrentRegion.Columns(1).Range(Cells(1, 1), Cells(Range("A1").CurrentRegion.Rows.Count, 1))
For Each cl In rn
    Select Case cl.Value
        Case "To"
            olMail.Recipients.Add(cl.Offset(0, 1).Value).Type = olTo
        Case "CC"
            olMail.Recipients.Add(cl.Offset(0, 1).Value).Type = olCC
        Case "BCC"
            olMail.Recipients.Add(cl.Offset(0, 1).Value).Type = olBCC
    End Select
    i = i + 1
Next cl
End Sub

问题是.. 最后一个收件人，即 f@xyz.com 总是被添加到收件人字段而不是密件抄送字段。 但是，如果我在表中创建 一个虚拟的空白最后一行条目，如下所示 Recipient Type = BCC 和 Recipient Address = " "（一个空格），然后代码工作并按原计划在 To、CC 和 BCC 字段中添加两个收件人

可能是什么原因？

Answer 1

尝试像这样调试：

For Each cl In rn
    Debug.Print cl.Address; cl.Parent.Name
    Select Case cl.Value
        Case "To"
            Debug.Print "adding "; cl.Offset(, 1); "TO"
            olMail.Recipients.Add(cl.Offset(0, 1).Value).Type = olTo
        Case "CC"
            Debug.Print "adding "; cl.Offset(, 1); "CC"
            olMail.Recipients.Add(cl.Offset(0, 1).Value).Type = olCC
        Case "BCC"
            Debug.Print "adding "; cl.Offset(, 1); "BCC"
            olMail.Recipients.Add(cl.Offset(0, 1).Value).Type = olBCC
    End Select
Next

然后看看你是否在即时窗口Ctrl+G中没有得到任何有趣的东西。

Answer 2

Select Case 似乎可以正常工作，但 Recipients.Add 方法存在一些问题。

但是，如果您愿意接受其他解决方案，您可以尝试使用以下代码：

Option Explicit

Sub Add_Recipients_Data_and_Type()
Dim olApp As Outlook.Application

Set olApp = GetObject(, "Outlook.Application")
Dim olMail As Outlook.MailItem

Set olMail = olApp.CreateItem(olMailItem)
olMail.Display
Dim rn      As Range
Dim cl      As Range
Dim mailTo  As String
Dim mailCC  As String
Dim mailBCC As String
Dim i       As Long

i = 1
Set rn = Range("A1").CurrentRegion.Columns(1).Range(Cells(1, 1), Cells(Range("A1").CurrentRegion.Rows.Count, 1))
For Each cl In rn
    Select Case cl.Value
        Case "To"
            mailTo = mailTo & cl.Offset(0, 1).Value & ";"
        Case "CC"
            mailCC = mailCC & cl.Offset(0, 1).Value & ";"
        Case "BCC"
            mailBCC = mailBCC & cl.Offset(0, 1).Value & ";"
    End Select
    i = i + 1
Next cl

olMail.To = mailTo
olMail.CC = mailCC
olMail.BCC = mailBCC
End Sub

Answer 3

似乎是一个错误。当我点击检查姓名时，密件抄送中添加了一个重复的 f@xyz.com。

我在代码中尝试了 ResolveAll 并且 f@xyz.com 在密件抄送中而不是收件人中。

Option Explicit

Sub Add_Recipients_Data_and_Type()

Dim olApp As Outlook.Application
Set olApp = GetObject(, "Outlook.Application")
Dim olMail As Outlook.MailItem
Set olMail = olApp.CreateItem(olMailItem)
olMail.Display
Dim rn As Range
Dim cl As Range
Dim i As Long
i = 1
Set rn = Range("A1").CurrentRegion.Columns(1).Range(Cells(1, 1), Cells(Range("A1").CurrentRegion.Rows.Count, 1))
For Each cl In rn
    Select Case cl.Value
        Case "To"
            olMail.Recipients.Add(cl.Offset(0, 1).Value).Type = olTo
        Case "CC"
            olMail.Recipients.Add(cl.Offset(0, 1).Value).Type = olCC
        Case "BCC"
            olMail.Recipients.Add(cl.Offset(0, 1).Value).Type = olBCC
    End Select
    i = i + 1
Next cl

olMail.Recipients.ResolveAll

End Sub