批量发送邮件会生成运行时错误2147023170：自动化错误远程过程调用失败

Question

如果我使用 F8 单步执行此代码，则代码可以正常工作。

如果我使用 F5 运行此代码，我会得到

运行时错误2147023170：自动化错误。远程过程调用失败。

我正在尝试通过 Outlook 发送批量邮件。特别是在

msg.display

行弹出运行时错误。

Sub prepare_all()
    Dim i As Integer
    Dim sh As Worksheet
    Set sh = ThisWorkbook.Sheets("Database")
    Dim testo As Variant
    Dim destinatario As Variant
    Dim subject As Variant

    Set allEmails = [emails]
    Application.Calculation = xlCalculationManual

    For i = 2 To sh.Range("A" & Application.Rows.Count).End(xlUp).Row
        testo = sh.Range("F" & i).Value
        destinatario = sh.Range("E" & i).Value
        subject = sh.Range("G2").Value
        mail testo, destinatario, subject
    Next i

    MsgBox "Mail inviate con successo"
End Sub

Sub mail(testo As Variant, destinatario As Variant, subject As Variant)
    Dim Outlook_App As Object
    Dim msg As Object
    Dim sign As String
    Dim i As Integer
    'Dim testo As Text
    Set Outlook_App = CreateObject("Outlook.Application")
    Dim sh As Worksheet
    Set sh = ThisWorkbook.Sheets("Database")
    'Set msg = Outlook_App.CreateItem(0)

    Set msg = Outlook_App.CreateItem(0)

    msg.display

    sign = msg.HTMLBody

    With msg
        .To = destinatario
        .subject = subject
        .HTMLBody = testo & sign
        '.display
        .send
    End With

    Set msg = Nothing
    Set Outlook_App = Nothing
End Sub

Answer 1

错误是

RPC_S_CALL_FAILED

- 这通常表示远程 COM 服务器 (Outlook) 正在处理传入或传出 RPC 调用，并且无法处理其他调用。

确保在处理 Outlook 事件或托盘图标事件处理程序时没有运行此代码 - 我之前在这两种情况下看到过此错误。