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
相关产品推荐
相关产品推荐

