来自Excel单元的电子邮件地址返回该地址无效的消息

Question

我创建了一个Excel宏，该宏可以使用模板生成电子邮件，并将其保存在草稿文件夹中，以便由我的团队成员发送。

是时候发送消息了，它会返回地址无效的消息。
地址正确。手动填充电子邮件是发送的。

Sub create_email()

Dim OutApp As Outlook.Application
Dim OutMail As Outlook.MailItem
Dim OutAccount As Outlook.Account

For linha = 2 To 16
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItemFromTemplate(' .oft file path)
    Set OutAccount = OutApp.Session.Accounts.Item(2)
    With OutMail
        .To = Cells(linha, 1).Value
        .CC = ' CC address
        .BCC = ' BCC address
        .Subject = ' text  & Cells(linha, 2)
        strFile = ""
        strFile = Dir(" ' file path ")  
        If strFile <> "" Then
            .Attachments.Add (ThisWorkbook.Path & "\Base - " & Cells(linha, 2).Value & ".xlsx")
            .SendUsingAccount = OutAccount
            .Save
          Else
            GoTo Fim
        End If
Fim:
        
    End With
Next

Set OutMail = Nothing
Set OutApp = Nothing
Set OutAccount = Nothing
End Sub

对于每个电子邮件地址，该代码都会陷入此问题。如果我将其更改为一个联系人名称组，则会创建相同的问题。

所有电子邮件都显示在草稿文件夹中，正确分开。

Answer 1

resolveall 可能会触发地址更新。

注意：当收件人在电子邮件地址格式中不是时，链接中的示例中的测试适用。

Option Explicit

Sub create_email()

    Dim OutApp As Outlook.Application
    Dim OutAccount As Outlook.Account
    Dim OutMail As Outlook.MailItem
    
    Dim myRecipients As Outlook.Recipients
    'Dim myRecipient As Outlook.Recipient
    
    Dim linha As Long
    
    Set OutApp = CreateObject("Outlook.Application")
    Set OutAccount = OutApp.Session.Accounts.Item(1)
    Debug.Print OutAccount
    
    For linha = 2 To 16
    
        'Set OutMail = OutApp.CreateItemFromTemplate(" .oft file path")
        Set OutMail = OutApp.CreateItem(olMailItem)
        
        With OutMail
        
            .To = Cells(linha, 1).Value
            .Subject = "Test " & linha
            
            Set myRecipients = OutMail.Recipients
            
            ' May trigger an address update
            myRecipients.ResolveAll
            
            ' Not for email address format. Resolved always True.
            '  https://learn.microsoft.com/en-us/office/vba/api/Outlook.Recipients.ResolveAll
            '
            'If Not myRecipients.ResolveAll Then
            '    For Each myRecipient In myRecipients
            '        If Not myRecipient.Resolved Then
            '            MsgBox myRecipient.Name
            '        End If
            '        Set myRecipient = Nothing
            '    Next
            'End If
            
            .Save
            '.Send
            
        End With
        
        Set OutMail = Nothing
        
    Next
    
    Set OutApp = Nothing
    Set OutAccount = Nothing
    
    Set myRecipients = Nothing
    
End Sub