Reply with .oft template and show images and attachments

Question

When I create an email from an .oft template it doesn't show all the content of the e-mail.
It's missing content like images and/or attachments.

I tried to merge Sub reply1() and 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()
This code doesn't show images or attachments of my own .oft mail.
It does show my e-mail signature but at the very bottom of both mails.
It does show the content of the e-mail I respond to correctly.

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() does the opposite of Sub Reply1.
It shows the images and attachments of my own .oft mail.
It will not show my e-mail signature correctly.
It will not display the content of the mail I respond to correctly. The images are missing

Sub Reply1() Results:

Sub Reply2() Results

score 0 · Answer 1 · answered Jul 27 '20 at 07:05

Embedded images are stored as hidden attachments on the email message. If you create a new Outlook item based on the template you need to re-attach the required images to get the message body rendered correctly. You can read more about that in the How to add an embedded image to an HTML message in Outlook 2010 thread.

Also, I have noticed the following code:

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

Remember, the HTML string should be a well-formed markup. If you want to insert something into the message body of an existing item you need to paste that inside the opening <body> and closing </body> elements. Otherwise, you may end up with a broken or improperly rendered message body. Even if Outlook do its great job by sorting most mistakes out.

Thanks for your answer! It was not exactly what i was looking for but i appreciate your interest — be the leaf, Aug 11 '20 at 09:10

be the leaf · Accepted Answer · 2020-08-11T09:07:25.100

The code below does work in my situation.

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

score 0 · Answer 3 · answered Aug 11 '20 at 18:40

Forwarding an email retains attachments.

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

Thank you Niton your code is much cleaner than my attempt. It will not add every image as an attachment that's perfect! But there is one thing missing when I tested your code. If the "Mail.oft" contains an attachments like for example a ReadMe.pdf file shown in the image "Sub Reply2()" It will not be in the reply mail. This is only the case for the .oft file not for the e-mail you reply to. Those attachments will be added to your E-mail. — be the leaf, Aug 13 '20 at 06:17

Reply with .oft template and show images and attachments

3 Answers3