You need to enable JavaScript to run this app.
优惠活动
大模型
产品
解决方案
定价
更多

Outlook VBA:从自定义模板创建的全部回复邮件中链接图片无法显示的问题求助

Outlook VBA:从自定义模板创建的全部回复邮件中链接图片无法显示的问题求助

我现在遇到一个Outlook VBA的棘手问题,想请各位帮忙排查:我写的代码是从自定义Outlook表单模板创建邮件项,同时生成原邮件的全部回复邮件,最后把回复邮件的内容追加到模板邮件里。但模板里的图片图标始终显示不出来,取而代之的是一个红叉,还附带提示:

The linked image cannot be displayed. The file may have been moved, renamed or deleted. Verify that the link points to the correct file and location.

以下是我的完整代码:

Public sTempPath        As String
Public sCat             As String
Public Const sDefaultPath As String = "pathtotemplate"

Public Sub LoadReplyTemplatesForm()
    frm_ReplyTemplates.Show
End Sub

Sub ReplyWithTemplate(sTempPath As String, sCat As String)
    Dim olItem              As mailItem
    Dim olReplyAll          As mailItem
    Dim olTemplateItem      As mailItem
    Dim olCategories        As Categories
    'Dim cid                 As String
    'Dim objFSO              As Object
    'Dim objTempFolder       As Object
    'Dim objAttachment       As Object
    'Dim sPath               As String
    'Dim sFile               As String

    On Error GoTo ErrorHandler

    ' select active mail item
    If TypeName(Application.ActiveWindow) = "Inspector" Then
        Set olItem = Application.ActiveWindow.CurrentItem
    Else
        Set olItem = Application.ActiveExplorer.Selection.Item(1)
    End If

    If olItem.Class = 43 Then   'olMail = 43
        Set olReplyAll = olItem.ReplyAll
        Set olTemplateItem = CreateItemFromTemplate(sTempPath, Application.Session.GetDefaultFolder(olFolderInbox))

        ' set selection object properties
        With olReplyAll
            .To = olItem.To
            .CC = olItem.CC
            .BCC = olItem.BCC
            ' check if category exists, if not, add it to Master list
            .Categories = olItem.Categories
            Set olCategories = Application.Session.Categories
            If Not InStr(1, olItem.Categories, sCat, vbTextCompare) > 0 Then
                On Error Resume Next
                olCategories.Add sCat, 20     'Dark Green
                On Error GoTo 0
                .Categories = .Categories & "," & sCat
            End If
            .FlagRequest = olItem.FlagRequest

            '.HTMLBody = olTemplateItem.HTMLBody ' Use the template's HTML body
            '            ' Extract and re-embed image attachments from the original email
            '            For Each objAttachment In olTemplateItem.Attachments
            '                If objAttachment.Type = olByValue Then ' Check if the attachment is an embedded image
            '                    cid = "cid:" & objAttachment.fileName ' Use the attachment's filename as the Content-ID (CID)
            '
            '                    Set objFSO = CreateObject("Scripting.FileSystemObject")
            '                    Set objTempFolder = objFSO.GetSpecialFolder(2) ' TemporaryFolder
            '                    sPath = objTempFolder.Path & "\"
            '                    If InStr(1, olTemplateItem.HTMLBody, cid, vbTextCompare) > 0 Then
            '                        With objAttachment
            '                            sFile = sPath & .fileName
            '                            .SaveAsFile sFile
            ''                            .Attachments.Add sFile, , , .DisplayName
            '                            .PropertyAccessor.SetProperty "http://schemas.microsoft.com/mapi/proptag/0x3712001F", "MyId1"
            '                            olTemplateItem.HTMLBody = Replace(olTemplateItem.HTMLBody, "cid", "cid:MyId1")
            '                        End With
            '                        objFSO.DeleteFile sFile
            '
            '                        ' Replace the original image link with the CID in the HTML body
            ''                        olTemplateItem.HTMLBody = Replace(olTemplateItem.HTMLBody, objAttachment.fileName, cid)
            '                    End If
            '                End If
            '            Next objAttachment

            .HTMLBody = olTemplateItem.HTMLBody & .HTMLBody

            '            ' Append the original email's HTML body
            '            .HTMLBody = .HTMLBody & "<br><br>" & olReplyAll.HTMLBody
            ' adding team image logo from template
            '            Set objFSO = CreateObject("Scripting.FileSystemObject")
            '            Set objTempFolder = objFSO.GetSpecialFolder(2) ' TemporaryFolder
            '            sPath = objTempFolder.Path & "\"
            '            For Each objAttachment In olReplyAll.Attachments
            '                With objAttachment
            '                    sFile = sPath & .fileName
            '                    .SaveAsFile sFile
            '                    .Attachments.Add sFile, , , .DisplayName
            '                End With
            '                objFSO.DeleteFile sFile
            '            Next objAttachment
            '            .Save

            .Display
        End With
    Else
        MsgBox "Not a Mail item!"
    End If

Cleanup:
    Exit Sub

ErrorHandler:
    MsgBox "Error Number: " & Err.Number & _
           " Error Description: " & Err.Description & _
           " Error Source: " & Err.Source, vbCritical + vbOKOnly, "Error!"
    On Error GoTo 0
    Err.Clear
    Resume Cleanup
End Sub

大家可以看到,我已经尝试了各种操作(代码里的注释部分就是我试过的方法):比如提取模板里的嵌入式图片并重新嵌入、手动修改图片的Content-ID(CID)、将图片保存到临时文件夹再重新添加为附件等等,但都没能解决图片显示的问题。

真心希望能得到各位的指点,谢谢!

备注:内容来源于stack exchange,提问作者sifar

相关产品推荐
方舟 Agent Plan

超全模态模型 × Harness 升级,最新支持 Deepseek-V4.1-Flash、GLM-5.3 系列、Doubao-Seedream-5.0-pro、Kimi-K3 (部分), 限时 9.9 元起

最近更新时间:2026.04.22 12:45:30