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\Micro soft\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