SMTP发信出现0x800ccc0b错误的原因及Access VBA CDO处理方案

你可以直接使用调整后的函数，已满足错误捕获、对象释放、布尔值返回的需求：

Public Function SendEmail() As Boolean
    ' 初始化返回值为失败
    SendEmail = False
    Dim Mail As CDO.Message
    
    On Error GoTo ErrorHandle
    
    Set Mail = New CDO.Message
    With Mail.Configuration.Fields
        .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2 'NTLM method
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"
        ' 修正原代码拼写错误：smpt -> smtp
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 587
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
        .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "FromEmail@gmail.com"
        .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "####"
        .Update
    End With
    
    With Mail
        .To = "ToEmail@Hotmail.com"
        .From = "FromEmail@gmail.com"
        .Subject = "Test Email"
        .TextBody = "Testing, please do not reply!"
        .Send
    End With
    
    ' 发送成功修改返回值
    SendEmail = True

Cleanup:
    ' 无论成功失败都释放对象，避免内存残留
    If Not Mail Is Nothing Then
        Set Mail = Nothing
    End If
    Exit Function

ErrorHandle:
    ' 可根据需要在这里打印错误信息调试，比如 Debug.Print Err.Number, Err.Description
    ' 你遇到的0x800ccc0b错误通常是Gmail限流，可在这里添加1-2秒的等待逻辑方便重试
    Resume Cleanup
End Function

核心改动说明 #

• 把原来的无返回值Sub调整为返回布尔值的Function，发送成功返回True，失败返回False，上层调用时可以直接根据返回值判断是否需要重试
• 新增错误捕获分支，触发错误时不会直接抛出未处理异常导致程序卡死，会自动进入清理流程
• 新增统一的对象清理节点，无论发送成功还是失败，都会主动释放CDO.Message对象，避免对象残留占用连接导致后续发送异常
• 修正了原代码中的字段拼写错误：原代码中smptserverport拼写有误，正确字段名为smtpserverport，该拼写问题也可能导致偶发的配置加载失败
• 针对你遇到的0x800ccc0b错误，属于SMTP服务器短时间内拒绝连接，通常是触发了Gmail的发送频率限制，你可以在错误处理分支添加Application.Wait Now + TimeValue("00:00:02")的等待逻辑，重试时成功率会更高

内容的提问来源于stack exchange，提问作者Shadyjunior