Office365中如何解决Outlook邮件嵌入Excel区域图片不显示问题？

问题根源 #

当前代码仅将图片作为嵌入附件添加，但未在HTML正文中通过cid（内容ID）关联该图片，导致正文无法显示图片，仅能以隐藏/可见附件形式存在。

修正方案 #

修改Create_Email子过程，为嵌入图片设置唯一Content ID，并在HTML正文中通过该ID引用图片，实现正文内显示。

完整修正代码 #

Sub a()
    Call Create_Email("first.last@domain.com", "test2")
End Sub

Sub Create_Email(ByVal strTo As String, ByVal strSubject As String)
    Dim rngToPicture As Range
    Dim outlookApp As Object
    Dim Outmail As Object
    Dim strTempFilePath As String
    Dim strTempFileName As String
    Dim imgAttachment As Object
    Dim imgCid As String

    ' 临时图片文件名
    strTempFileName = "RangeAsPNG"
    ' 定义要转换的单元格区域
    Set rngToPicture = Range("A1:D30")
    Set outlookApp = CreateObject("Outlook.Application")
    Set Outmail = outlookApp.CreateItem(0) ' 用数值0替代olMailItem，避免常量未定义问题

    ' 创建邮件
    With Outmail
        .To = strTo
        .Subject = strSubject

        ' 生成区域对应的PNG图片到临时文件夹
        Call createPNG(rngToPicture, strTempFileName)
        strTempFilePath = Environ$("temp") & "\" & strTempFileName & ".png"

        ' 添加图片为嵌入附件（第三个参数0表示嵌入，不在附件列表显示）
        Set imgAttachment = .Attachments.Add(strTempFilePath, 1, 0) ' 用数值1替代olByValue
        ' 设置图片的Content ID，用于HTML正文引用
        imgCid = "RangeImage_" & Format(Now, "YYYYMMDDHHMMSS") ' 生成唯一ID避免冲突
        imgAttachment.PropertyAccessor.SetProperty "http://schemas.microsoft.com/mapi/proptag/0x3712001F", imgCid

        ' 构造HTML正文，引用嵌入的图片
        .HTMLBody = "Hello<br><br><img src='cid:" & imgCid & "' style='max-width:100%;'>"
        .Display
    End With

    ' 清理对象
    Set imgAttachment = Nothing
    Set Outmail = Nothing
    Set outlookApp = Nothing
    Set rngToPicture = Nothing
End Sub

Sub createPNG(ByRef rngToPicture As Range, nameFile As String)
    Dim wksName As String
    wksName = rngToPicture.Parent.Name

    ' 删除已存在的同名临时图片
    On Error Resume Next
        Kill Environ$("temp") & "\" & nameFile & ".png"
    On Error GoTo 0

    ' 复制区域为图片（指定复制格式为屏幕显示样式）
    rngToPicture.CopyPicture xlScreen, xlPicture
    ' 创建对应尺寸的图表对象，粘贴图片并导出为PNG
    With ThisWorkbook.Worksheets(wksName).ChartObjects.Add(rngToPicture.Left, rngToPicture.Top, rngToPicture.Width, rngToPicture.Height)
        .Chart.Paste
        .Chart.Export Environ$("temp") & "\" & nameFile & ".png", "PNG"
        .Delete ' 直接清理临时图表，无需计数查找
    End With
End Sub

关键修改点说明 #

• 避免常量报错：用数值替代Outlook常量（如0代替olMailItem），无需引用Outlook对象库即可运行。
• 绑定Content ID：通过PropertyAccessor为嵌入附件设置唯一ID，确保HTML能精准关联到目标图片。
• HTML引用图片：在.HTMLBody中使用<img src='cid:xxx'>标签，直接调用嵌入的图片资源。
• 优化临时文件处理：导出后直接删除临时图表，简化代码逻辑。

额外注意事项 #

• 临时图片会留在系统临时文件夹，若需自动清理，可在Create_Email末尾添加Kill strTempFilePath。
• 若需保留原有邮件正文格式，可将.HTMLBody改为拼接原有内容（如.HTMLBody = 原HTML内容 & "<br><img...>"）。

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