Reply to email with template without creating a new email (keep email chain/origina m

[kcitti]

Hi All,

Very, very new to VBA. Created a macro in Outlook that contains a template. I want to be able to reply to an email with a template, appending "Please Complete Template:" to the original subject line and keeping the message history just like a normal email reply. Instead the macro I have creates a new email containing the template. I'm sure it's an easy fix.

In short - I want to reply to a message as usual, keeping the message history, but include a form via macro rather than finding it and inserting it, and appending "Please Complete Template:" to the beginning of the email.

Current macro:

Sub MAP()
Set msg = Application.CreateItemFromTemplate("C:\Users\redacted\AppData\Roaming\Microsoft\Templates\Map.oft")
msg.Display
Attachments.Add Item
End Sub



Example:

Receive Mail
to ktiatoutlook.com
from XYZatoutlook.com
Subject: Do this please

Hi KTI please do this for me.

----------------------

I want to manually open and review email, then click a macro to send boilerplate response, like so:

Reply Mail
to: XYZatoutlook.com
from KTIatoutlook.com
Subject: Please Complete Template - Re: Do this please

<insert template here (macro above>

<maintain original message here >

[gmayor]

It is not possible to do this without third party software, though it may be possible to create a workaround. The problem relates to your template and what it contains. It might be preferable to recreate your template content in the reply message and not use a template, but in order to take that forward it would be necessary to see what the template contains. Can you attach a copy of your Outlook template to your reply?

[gmayor]

On further reflection the following may work, though I am not sure of the effect of changing the subject on the message history.

Option Explicit
Sub CreateReplyFromTemplate()
Dim olInsp As Outlook.Inspector
Dim olRepInsp As Outlook.Inspector
Dim wdDoc As Object
Dim wdDoc2 As Object
Dim oRng As Object
Dim oSource As Object
Dim oBM As Object
Dim olItem As Outlook.MailItem
Dim olItemReply As Outlook.MailItem
Dim olTempItem As Outlook.MailItem
Dim sTemplate As String

sTemplate = Environ("AppData") & "\Microsoft\Templates\Map.oft"
On Error Resume Next
Set olItem = ActiveExplorer.Selection.Item(1)
Set olItemReply = olItem.Reply
Set olTempItem = Application.CreateItemFromTemplate(sTemplate)
With olTempItem
.BodyFormat = olFormatHTML
Set olInsp = .GetInspector
Set wdDoc = olInsp.WordEditor
Set oBM = wdDoc.Bookmarks("_MailAutoSig")
If Not oBM Is Nothing Then
oBM.Range.Delete
End If
Set oSource = wdDoc.Range
End With
With olItemReply
.BodyFormat = olFormatHTML
.subject = "Please Complete Template - " & .subject
Set olRepInsp = .GetInspector
Set wdDoc2 = olRepInsp.WordEditor
Set oRng = wdDoc2.Range(0, 0)
.Display 'This line is required
oRng.formattedtext = oSource.formattedtext
'.Send 'Remove the apostrophe from the start of this line after testing
End With
olTempItem.Close olDiscard
lbl_Exit:
Set olItemReply = Nothing
Set olItem = Nothing
Set olTempItem = Nothing
Set olInsp = Nothing
Set wdDoc = Nothing
Set oRng = Nothing
Set oBM = Nothing
Exit Sub
End Sub