Excel VBA通过CDO发送Gmail时内嵌图片无法显示问题求助

你的问题核心是没有正确标记附件为HTML邮件的内嵌资源，直接用AddAttachment会把文件识别为普通附件，而非内嵌到邮件内容里的关联资源。以下是两种可行的解决方法：

方法1：使用AddRelatedBodyPart（推荐） #

CDO.Message提供了专门用于添加HTML内嵌资源的AddRelatedBodyPart方法，它会自动将资源标记为内嵌，不会显示为独立附件。

把你代码中的AddAttachment行替换为：

NewMail.AddRelatedBodyPart "C:\Users\bradb\OneDrive\Desktop\SWC-Signature.png", "SWC-Signature.png", 0

第二个参数就是HTML中cid:对应的标识，和你现有代码里的<img src='cid:SWC-Signature.png'>完全匹配即可。

方法2：修正AddAttachment的用法 #

如果坚持用AddAttachment，需要手动设置附件的ContentID和显示方式为inline（内嵌）：

Dim imgAttachment As Object
Set imgAttachment = NewMail.AddAttachment("C:\Users\bradb\OneDrive\Desktop\SWC-Signature.png")
' 设置ContentID，注意要加<>
imgAttachment.Fields("urn:schemas:mailheader:content-id") = "<SWC-Signature.png>"
imgAttachment.Fields.Update
' 设置附件显示方式为内嵌
imgAttachment.Configuration.Fields.Item("urn:schemas:mailheader:content-disposition") = "inline"
imgAttachment.Configuration.Fields.Update

此时HTML中的cid可以写成cid:SWC-Signature.png（无需<>），和设置的ContentID对应。

完整修改后的代码（方法1示例） #

Dim NewMail As Object
Dim mailConfig As Object
Dim fields As Variant
Dim msConfigURL, StrBody As String

On Error GoTo Err:

' late binding
Set NewMail = CreateObject("CDO.Message")
Set mailConfig = CreateObject("CDO.Configuration")

' 加载默认配置
mailConfig.Load -1

Set fields = mailConfig.fields

StrBody = "Hello " & TextBox2.Value & ", <p> " & _
            "请确认你的队伍选择和平均分组，<br>" & _
            "如果发现错误，请回复正确信息。<p>" & _
            "队伍: " & ComboBox1.Value & ", <br> " & _
            "平均成绩: " & TextBox9.Value

' 设置邮件属性
With NewMail
    .From = "brad.bylls@swcbowl.com"  ' 发件人邮箱
    .To = TextBox7.Value
    .CC = ""
    .BCC = ""
    .Subject = "40 Frame Game Tournament Confirmation  " & Format(Date, "m/d/yy")
    ' 添加内嵌图片资源
    .AddRelatedBodyPart "C:\Users\bradb\OneDrive\Desktop\SWC-Signature.png", "SWC-Signature.png", 0
    .HTMLBody = "<HTML><BODY style=font-size:18pt; font-family:Arial;>" & StrBody & _
    "<img src='cid:SWC-Signature.png' width='375'>" & _
    "<p>谢谢<br>Brad Bylls<br>赛事经理</p></BODY></HTML>"
End With

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") = "brad.bylls@swcbowl.com" ' 邮箱账号
    .Item(msConfigURL & "/sendpassword") = "**** **** **** ****"
    .Update                                               ' 更新配置
End With
NewMail.Configuration = mailConfig
NewMail.Send

Err:
' 错误处理逻辑
If Err.Number <> 0 Then
    MsgBox "邮件发送失败：" & Err.Description, vbCritical
End If

注：你代码中的enable_html = True是无效语句，CDO.Message没有该属性，直接设置HTMLBody就会自动识别为HTML格式邮件，可删除该行。

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