VBA嵌入PNG到Outlook邮件本地可显示收件人无法查看问题求解

问题原因 #

你当前的代码直接引用本地文件路径作为图片src，该路径仅在你的本地设备有效，收件人设备不存在对应路径，因此无法加载图片。要实现真正的嵌入式图片，需要将图片作为邮件隐藏附件添加，再通过CID（内容ID）在HTML正文中关联引用该附件。

修改后的完整代码 #

Sub Mail_workbook_Outlook_1()
    Dim OutlookApp As Object
    Dim OutlookMessage As Object
    Dim imgAttach As Object
    Dim relativepath1 As String
    ' 定义MAPI属性常量
    Const PR_ATTACH_CONTENT_ID = "http://schemas.microsoft.com/mapi/proptag/0x3712001F"
    Const PR_ATTACHMENT_HIDDEN = "http://schemas.microsoft.com/mapi/proptag/0x7FFE000B"

    ' 初始化Outlook应用
    On Error Resume Next
    Set OutlookApp = GetObject(, "Outlook.Application")
    If Err.Number <> 0 Then
        Set OutlookApp = CreateObject("Outlook.Application")
    End If
    On Error GoTo 0

    relativepath1 = ThisWorkbook.Path & Application.PathSeparator & "Signature99" & ".png"

    ' 创建新邮件
    Set OutlookMessage = OutlookApp.CreateItem(0)

    On Error Resume Next
    With OutlookMessage
        .To = Prime_Email
        .CC = cc1
        .BCC = ""
        .Subject = "Volume - " & " " & str2 & "(" & Subject & ")"
        
        ' 添加图片作为隐藏附件并设置内容ID
        Set imgAttach = .Attachments.Add(relativepath1)
        imgAttach.PropertyAccessor.SetProperty PR_ATTACH_CONTENT_ID, "Signature99Img"
        imgAttach.PropertyAccessor.SetProperty PR_ATTACHMENT_HIDDEN, True
        
        ' HTML正文用cid引用图片
        .HTMLBody = RangetoHTML(Range("E2:N16")) & "<img src ='cid:Signature99Img'>"
        .send
        '.Display
    End With
    On Error GoTo 0

    ' 释放对象
    Set imgAttach = Nothing
    Set OutlookMessage = Nothing
    Set OutlookApp = Nothing
End Sub

关键修改说明 #

• 新增了MAPI属性常量，用于设置附件的特殊属性
• 补全了Outlook应用实例的初始化逻辑，避免Outlook未启动时代码报错
• 将图片作为邮件附件添加后，通过PropertyAccessor设置两个关键属性：
  • PR_ATTACH_CONTENT_ID：给图片附件分配唯一标识Signature99Img
  • PR_ATTACHMENT_HIDDEN：设置为True，让图片不会显示在收件人的附件列表中，仅作为正文内嵌资源
• 将HTML中img标签的src从本地路径改为cid:Signature99Img，和前面设置的内容ID一一对应，Outlook会自动将附件和正文引用关联渲染

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