使用Excel VBA调用Outlook的 Send时，在较新的Office 365版本中会触发错误80004005

编程语言 2026-07-09

我有一段Excel VBA代码，用来发送邮件，已经稳定运行了好几个月，甚至谈不上有几年那么久。

最近（首次在一台PC上于上周三观察到）向SMTP地址发送邮件失败，出现错误代码80004005（来自法语的翻译）：

无法识别一个或多个名称

使用相同的数据和相同的VBA代码在同一个工作簿中发送邮件，在其他电脑上仍然可以正常工作。

现在，在我测试过的所有电脑上都出现了这个错误。

他们在Windows 11上使用Office 365。

Copilot分析的最后结论是，Outlook现在出于安全原因在发送邮件前需要经过一个交互阶段，因此你需要：

将 .Send 替换为 .Display，并通过UI按钮发送
或在 .Send 之前插入 .Display 和 DoEvents

最后一种方案在发送时不会出错，但在大量发送邮件时看起来有点花哨。

有谁能确认Copilot的这一说法吗（它还表示这部分没有被微软记录在案），并可能给出一个不那么花哨的替代方案？

我可以重现这个错误，并用下面在Excel中的VBA来测试这个“变通办法”：

Option Explicit

Sub test()

    Dim olApp As Outlook.Application
    ' Tente de récupérer Outlook déjà ouvert
    On Error Resume Next
    Set olApp = GetObject(, "Outlook.Application")
    On Error GoTo 0

    ' Si Outlook n'est pas ouvert : le créer
    If olApp Is Nothing Then
        On Error Resume Next
        Set olApp = CreateObject("Outlook.Application")
        On Error GoTo 0
    End If

    Dim olMail As Outlook.MailItem
    Set olMail = olApp.CreateItem(olMailItem)
    With olMail
        .recipients.Add "[email protected]"
        .Subject = "Test"
        .Body = "Bonjour"
        '.Display
        'DoEvents
        .Send
    End With

End Sub

解决方案

确实只需要在.Send之前调用.recipients.ResolveAll。.Display也必须触发过一次.recipients.ResolveAll。因此，以下写法就能正常工作：

Option Explicit

Sub test()

    Dim olApp As Outlook.Application
    ' Tente de récupérer Outlook déjà ouvert
    On Error Resume Next
    Set olApp = GetObject(, "Outlook.Application")
    On Error GoTo 0

    ' Si Outlook n'est pas ouvert : le créer
    If olApp Is Nothing Then
        On Error Resume Next
        Set olApp = CreateObject("Outlook.Application")
        On Error GoTo 0
    End If

    Dim olMail As Outlook.MailItem
    Set olMail = olApp.CreateItem(olMailItem)
    With olMail
        .recipients.Add "[email protected]"
        .Subject = "Test"
        .Body = "Bonjour"
        .recipients.ResolveAll
        .Send
    End With

End Sub

Outlook