☰

Outlook VBA - ReplyAll 邮件项目中的链接图像从模板中的自定义创建不显示

tag-icon • tag-icon microsoft-outlook vba images templates outlook-form
Outlook VBA - ReplyAll 邮件项目中的链接图像从模板中的自定义创建不显示

以下代码从自定义 Outlook 表单模板和 ReplyAll 邮件项创建一个邮件项，并将 ReplyAll 邮件项附加到模板邮件项。但是，Outlook 表单模板中的图像图标不会显示。而是用文本占位符替换红色十字 (x)，并显示以下消息：

在此处输入图片描述

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

正如您从注释代码中看到的，我尝试了各种操作来显示图像图标，但都没有成功。

非常感谢您的帮助！

答案1

据我所知，当 BlockHTTPimages 注册表值设置为 1 并且电子邮件中的图像具有指向 URL 的源时，就会发生此问题。请参阅本文并尝试解决方案：

Outlook 电子邮件中无法显示链接图像的错误

相关内容