Ошибка в цикле Outlook VBA через получателей - PullRequest
Новая
       16

Ошибка в цикле Outlook VBA через получателей

0 голосов
/ 11 сентября 2018

У меня есть лист 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 всегда добавляется в поле «Кому» вместо поля «BCC». Однако, если я сделаю пустую пустую запись в последней строке в таблице следующим образом тип получателя = BCC и адрес получателя = "" (один пустой пробел), затем код работает и добавляет двух получателей в поле «Кому», «CC» и «BCC», как первоначально предполагалось

Что может бытьпричина?

Ответы [ 3 ]

0 голосов
/ 11 сентября 2018

Кажется, что работает 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
0 голосов
/ 12 сентября 2018

Кажется, это ошибка. Когда я нажимаю «Проверить имена», в Bcc добавляется дубликат 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
0 голосов
/ 11 сентября 2018

Попробуйте отладить так: 

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 .

...