Excel区域转图片通过Outlook发送时收件人报图片无法显示错误如何解决

这个报错是因为嵌入邮件的图片和附件没有建立正确的关联标识，你虽然把图片作为附件添加了，但没有给附件设置对应的Content ID，Outlook无法匹配HTML里cid:DashboardFile.jpg对应的附件资源，就会默认当成外部链接图片读取，找不到就报错。

具体修复步骤 #

• 给图片附件添加PR_ATTACH_CONTENT_ID属性，值和HTML里的cid保持完全一致
• 修复原代码里的语法错误：收件人地址少闭合引号、字符串换行拼接错误、HTML标签嵌套错误的问题
• 提前定义Outlook常量，避免后期绑定模式下找不到常量报错
• 恢复代码末尾的应用状态配置，避免后续Excel操作异常

修正后的完整代码 #

' 提前定义Outlook相关常量，后期绑定模式下必须声明
Const olMailItem = 0
Const olByValue = 1
Const PR_ATTACH_CONTENT_ID = "http://schemas.microsoft.com/mapi/proptag/0x3712001F"

Sub RectangleRoundedCorners1_Click()
    ActiveSheet.Unprotect Password:="Mortgage1"
    Dim TempFilePath As String
    Dim xOutApp As Object
    Dim xOutMail As Object
    Dim xAttach As Object
    Dim xHTMLBody As String
    Dim xRg As Range
    Dim StrBody As String
    
    On Error Resume Next
    Set xRg = ActiveSheet.Range("C5:F17")
    If xRg Is Nothing Then Exit Sub
    
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With
    
    ActiveSheet.Shapes("Rectangle: Rounded Corners 13").Visible = False

    Set xOutApp = CreateObject("outlook.application")
    Set xOutMail = xOutApp.CreateItem(olMailItem)
    
    ' 生成截图到系统临时目录
    Call createJpg(ActiveSheet.Name, xRg.Address, "DashboardFile")
    TempFilePath = Environ$("temp") & "\"
    
    ' 拼接HTML内容，cid值和后续设置的ContentID完全匹配
    xHTMLBody = "<span LANG=EN>" _
            & "<p class=style2><span LANG=EN><font FACE=Calibri SIZE=3>" _
            & "<img src='cid:DashboardFile'>"
            
    StrBody = "<br /><b><font size=5 color=red>Rates are subject to change without notice</font></b>"
    
    With xOutMail
        .Subject = "Bench Mark Rates " & Date
        .HTMLBody = xHTMLBody & StrBody
        ' 添加附件并设置ContentID，关联HTML中的cid
        Set xAttach = .Attachments.Add(TempFilePath & "DashboardFile.jpg", olByValue)
        xAttach.PropertyAccessor.SetProperty PR_ATTACH_CONTENT_ID, "DashboardFile"
        ' 修复原代码漏写的地址闭合引号
        .To = "mcerrato@hotmail.com"
        .CC = "mcerrato@loandepot.com"
        .Display
    End With
    
    ' 清理对象释放内存
    Set xAttach = Nothing
    Set xOutMail = Nothing
    Set xOutApp = Nothing
    
    ActiveSheet.Shapes("Rectangle: Rounded Corners 13").Visible = True
    ActiveSheet.Protect Password:="Mortgage1"
    
    ' 恢复Excel应用配置
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub

补充排查项 #

如果修改后仍有异常，可检查createJpg函数逻辑，确认生成的图片确实保存在系统临时目录下，文件名完全为DashboardFile.jpg，无拼写或后缀错误。

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