使用VBA通过Gmail发邮件请求已读回执时遭遇438错误的技术问询

问题根源 #

你使用的CDO.Message对象并不支持ReadReceiptRequested属性——这个属性是Outlook的MailItem对象专属的，直接调用自然会触发438错误。要给CDO邮件添加已读回执请求，需要通过设置CDO的邮件头字段来实现。

解决方法 #

1. 替换报错代码：
   在With NewMail代码块中，把.ReadReceiptRequested = True替换为以下代码：

   ' 设置已读回执，指定回执发送回发件人
   .Fields("urn:schemas:mailheader:disposition-notification-to") = .From
   .Fields.Update
   

   这段代码通过设置邮件头的disposition-notification-to字段，完成已读回执的请求设置。

2. 修复代码逻辑漏洞：
   原代码中Exit_Err标签和对象释放语句放在循环内部，会导致第一封邮件发送后就终止程序，后续邮件无法发送。需要将这部分代码移到循环结束后；同时邮件配置无需在循环内重复设置，初始化一次即可提升效率。

修改后的完整代码 #

Sub SendEmailUsingGmail()
    Dim NewMail As Object
    Dim mailConfig As Object
    Dim fields As Variant
    Dim msConfigURL As String
    Dim RList As Range
    Dim R As Range
    Dim path As String
    
    On Error GoTo Err:

    Set NewMail = CreateObject("CDO.Message")
    Set mailConfig = CreateObject("CDO.Configuration")
    mailConfig.Load -1
    Set fields = mailConfig.fields

    ' 初始化邮件配置，仅执行一次
    msConfigURL = "http://schemas.microsoft.com/cdo/configuration"
    With fields
        .Item(msConfigURL & "/smtpusessl") = True             ' 启用SSL认证
        .Item(msConfigURL & "/smtpauthenticate") = 1          ' 启用SMTP认证
        .Item(msConfigURL & "/smtpserver") = "smtp.gmail.com" ' 设置SMTP服务器
        .Item(msConfigURL & "/smtpserverport") = 465          ' 设置SMTP端口
        .Item(msConfigURL & "/sendusing") = 2                 ' 使用默认发送设置
        .Item(msConfigURL & "/sendusername") = "mymail@gmail.com" ' 你的Gmail地址
        .Item(msConfigURL & "/sendpassword") = "mypassword" ' 你的密码或应用专用密码
        .Update                                               ' 更新配置
    End With
    NewMail.Configuration = mailConfig

    Set RList = Range("A2", Range("a2").End(xlDown))
    path = "C:\filepath\"

    ' 批量发送邮件
    For Each R In RList
        With NewMail
            .From = "mymail@gmail.com"
            .To = R.Offset(0, 2)
            .CC = ""
            .BCC = ""
            .Subject = "Testing Auto Mail for: " & R & " " & R.Offset(0, 1)
            .TextBody = "Text Body"
            .AddAttachment (path & R.Offset(0, 3))
            
            ' 设置已读回执请求
            .Fields("urn:schemas:mailheader:disposition-notification-to") = .From
            .Fields.Update
        End With
        
        NewMail.Send
        MsgBox "邮件已发送给: " & R.Offset(0, 2), vbInformation
    Next R

Exit_Err:
    ' 释放对象内存，放在循环结束后
    Set NewMail = Nothing
    Set mailConfig = Nothing
    Exit Sub
    
Err:
    Select Case Err.Number
        Case -2147220973  ' 网络连接问题
            MsgBox "检查你的网络连接。" & vbNewLine & Err.Number & ": " & Err.Description
        Case -2147220975  ' 登录凭证错误
            MsgBox "检查你的登录凭证后重试。" & vbNewLine & Err.Number & ": " & Err.Description
        Case Else   ' 其他未知错误
            MsgBox "发送邮件时遇到错误。" & vbNewLine & Err.Number & ": " & Err.Description
    End Select
    Resume Exit_Err
End Sub

补充说明 #

• Gmail的已读回执是可选的：收件人可以自主选择是否发送回执，无法强制对方返回。
• 应用专用密码：如果你的Gmail开启了两步验证，必须使用Google应用专用密码代替普通登录密码，否则会出现认证失败。

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