问用.oft模板回复并显示图像和附件
EN

Stack Overflow用户

提问于 2020-07-22 02:12:01

回答 3查看 889关注 0票数 0

当我从.oft模板创建电子邮件时，它并不会显示电子邮件的所有内容。

它缺少图像和/或附件之类的内容。

我尝试合并Sub reply1()和Sub reply2()：

Sub Reply1()

Dim Original As Outlook.MailItem
Dim Reply As Outlook.MailItem
Set Original = Application.ActiveExplorer.Selection(1).Reply
Set Reply = Application.CreateItemFromTemplate("C:\Outlook\Mail.oft")

Original.HTMLBody = Reply.HTMLBody & Original.HTMLBody
Original.Display
End Sub

Sub Reply1()

此代码不显示我自己的.oft邮件的图像或附件。

它确实显示了我的电子邮件签名，但在两封邮件的最底部。

它确实显示了我正确回复的电子邮件的内容。

Sub Reply2()

Dim origEmail As MailItem
Dim replyEmail As MailItem

Set origEmail = ActiveExplorer.Selection(1)
Set replyEmail = CreateItemFromTemplate("C:\Outlook\Mail.oft")

replyEmail.To = origEmail.Reply.To

replyEmail.HTMLBody = replyEmail.HTMLBody & origEmail.Reply.HTMLBody
replyEmail.Recipients.ResolveAll
replyEmail.Display

Set origEmail = Nothing
Set replyEmail = Nothing

End Sub

Sub Reply2()与Sub Reply1相反。

它显示了我自己的.oft邮件的图像和附件。

它将不能正确显示我的电子邮件签名。

它不会显示我正确回复的邮件的内容。图像不见了

Sub Reply1()结果：

子Reply2()结果

vba

outlook

在线客服搭建方案

搭建集AI机器人、在线客服、智能外呼等多功能服务的客服系统，支持快速接入及自搭建客服系统，从而让顾客快速得到解答

回答 3

Stack Overflow用户

回答已采纳

发布于 2020-08-11 01:00:48

下面的代码确实适用于我的情况。

Sub Reply1()
Dim fromTemplate As MailItem
Dim reply As MailItem
Dim oItem As Object

Set fromTemplate = CreateItemFromTemplate("C:\Outlook\Mail.oft")

Set oItem = GetCurrentItem()
If Not oItem Is Nothing Then
Set reply = oItem.ReplyAll
CopyAttachments oItem, fromTemplate, reply
    
reply.HTMLBody = fromTemplate.HTMLBody & reply.HTMLBody
    
reply.Display
oItem.UnRead = False
End If
 
Set reply = Nothing
Set oItem = Nothing
End Sub


Function GetCurrentItem() As Object
Dim objApp As Outlook.Application
     
Set objApp = Application
On Error Resume Next
Select Case TypeName(objApp.ActiveWindow)
Case "Explorer"
Set GetCurrentItem = objApp.ActiveExplorer.Selection.Item(1)
Case "Inspector"
Set GetCurrentItem = objApp.ActiveInspector.CurrentItem
End Select
 
Set objApp = Nothing
End Function

Sub CopyAttachments(source1, source2, objTargetItem)
Set fso = CreateObject("Scripting.FileSystemObject")
Set fldTemp = fso.GetSpecialFolder(2) ' TemporaryFolder
strPath = fldTemp.Path & "\"
For Each objAtt In source1.Attachments
strFile = strPath & objAtt.fileName
objAtt.SaveAsFile strFile
objTargetItem.Attachments.Add strFile, , , objAtt.DisplayName
fso.DeleteFile strFile
Next

For Each objAtt In source2.Attachments
strFile = strPath & objAtt.fileName
objAtt.SaveAsFile strFile
objTargetItem.Attachments.Add strFile, , , objAtt.DisplayName
fso.DeleteFile strFile
Next

Set fldTemp = Nothing
Set fso = Nothing
End Sub

票数 0

Stack Overflow用户

发布于 2020-07-26 23:05:18

嵌入的图像作为隐藏的附件存储在电子邮件中。如果基于模板创建新的Outlook项，则需要重新附加所需的图像，以使消息体正确呈现。您可以在How to add an embedded image to an HTML message in Outlook 2010线程中阅读更多有关这方面的内容。

此外，我注意到以下代码：

replyEmail.HTMLBody = replyEmail.HTMLBody & origEmail.Reply.HTMLBody

记住，HTML字符串应该是格式良好的标记.如果要将某些内容插入到现有项的消息正文中，则需要将其粘贴到打开的<body>中并关闭</body>元素。否则，您可能会得到一个损坏或不正确呈现的消息体。即使Outlook通过整理大多数错误来完成它的伟大工作。

票数 0

Stack Overflow用户

发布于 2020-08-11 10:40:12

转发电子邮件保留附件。

Option Explicit ' Consider this mandatory
' Tools | Options | Editor tab
' Require Variable Declaration
' If desperate declare as Variant


Sub Reply_Retain_Attachments()

    Dim fromTemplate As MailItem
    Dim origEmail As MailItem
    Dim forwardEmail As MailItem
    
    Set fromTemplate = CreateItemFromTemplate("C:\Outlook\Mail.oft")
    
    Set origEmail = GetCurrentItem()
    
    If Not origEmail Is Nothing Then
    
        ' Forward retains attachments
        Set forwardEmail = origEmail.Forward
        
        forwardEmail.HTMLBody = fromTemplate.HTMLBody & forwardEmail.HTMLBody
        
        forwardEmail.To = origEmail.reply.To ' keep .reply here
        
        forwardEmail.Recipients.ResolveAll
        forwardEmail.Display
        
    Else
        ' This may never occur
        MsgBox "GetCurrentItem is nothing?"
        
    End If

End Sub

Function GetCurrentItem() As Object
     
    'On Error Resume Next ' uncomment if you find it necessary
    
    Select Case TypeName(ActiveWindow)
    Case "Explorer"
        Set GetCurrentItem = ActiveExplorer.Selection.item(1)
    Case "Inspector"
        Set GetCurrentItem = ActiveInspector.CurrentItem
    End Select

End Function