使用 .oft 模板回复并显示图像和附件
Reply with .oft template and show images and attachments
当我从 .oft 模板创建电子邮件时,它没有显示电子邮件的所有内容。
它缺少图像 and/or 附件等内容。
我尝试合并 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
子回复1()
此代码不显示我自己的 .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 邮件的图像和附件。
它不会正确显示我的电子邮件签名。
它不会显示我正确回复的邮件内容。图片丢失
子回复1()结果:
Sub Reply2() 结果
嵌入的图像作为隐藏附件存储在电子邮件中。如果您根据模板创建新的 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 通过排除大多数错误来完成它的出色工作。
下面的代码确实适用于我的情况。
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
转发电子邮件会保留附件。
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
当我从 .oft 模板创建电子邮件时,它没有显示电子邮件的所有内容。
它缺少图像 and/or 附件等内容。
我尝试合并 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
子回复1()
此代码不显示我自己的 .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 邮件的图像和附件。
它不会正确显示我的电子邮件签名。
它不会显示我正确回复的邮件内容。图片丢失
子回复1()结果:
Sub Reply2() 结果
嵌入的图像作为隐藏附件存储在电子邮件中。如果您根据模板创建新的 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 通过排除大多数错误来完成它的出色工作。
下面的代码确实适用于我的情况。
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
转发电子邮件会保留附件。
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