Replyall macro with template and auto insert receptens

[Madsfrost]

Hello !

I am trying to "merge" the Automatic insert receptens name and replyall with template macro.. What am i doing wrong ??

Im trying to merge theese 2. They work seperately. But after adding the autoinsert names to field the Replyall macro with template wont add the item.

GOAL: Is that the Replyall with template macro auto inserts Name of the sender in the Text field "Hello <Name of sender>

Auto insert names to field macro:

Option Explicit
Private WithEvents oExpl As Explorer
Private WithEvents oItem As MailItem
Private bDiscardEvents As Boolean
Dim oResponse As MailItem

Private Sub Application_Startup()
Set oExpl = Application.ActiveExplorer
bDiscardEvents = False
End Sub

Private Sub oExpl_SelectionChange()
On Error Resume Next
Set oItem = oExpl.Selection.Item(1)
End Sub

' Reply
Private Sub oItem_Reply(ByVal Response As Object, Cancel As Boolean)
Cancel = True
bDiscardEvents = True

Set oResponse = oItem.Reply
afterReply
End Sub

Private Sub oItem_Forward(ByVal Response As Object, Cancel As Boolean)
Cancel = True
bDiscardEvents = True

Set oResponse = oItem.Forward

afterReply
End Sub

Private Sub oItem_ReplyAll(ByVal Response As Object, Cancel As Boolean)
Cancel = True
bDiscardEvents = True

Set oResponse = oItem.ReplyAll

afterReply
End Sub

Private Sub afterReply()
oResponse.Display
' get the recipient names
Dim Recipients As Outlook.Recipients
Dim R As Outlook.Recipient
Dim i
Dim strTo As String, strCC As String

Set Recipients = oResponse.Recipients
For i = 1 To Recipients.Count
Set R = Recipients.Item(i)

Debug.Print R.Name, R.Type

If R.Type = olCC Then
strCC = R.Name & ", " & strCC
Else
strTo = R.Name & ", " & strTo
End If
Next

'insert the names
Dim olInspector As Outlook.Inspector
Dim olDocument As Word.Document
Dim olSelection As Word.Selection

Set olInspector = Application.ActiveInspector()
Set olDocument = olInspector.WordEditor
Set olSelection = olDocument.Application.Selection

olSelection.InsertBefore "CC: " & strCC
olSelection.InsertParagraphBefore
olSelection.InsertBefore "To: " & strTo

End Sub

Replyall with template macro

Sub Bookingnyordre()

Dim origEmail As MailItem
Dim replyEmail As MailItem

Set origEmail = ActiveExplorer.Selection(1)
Set replyEmail = CreateItemFromTemplate("\\alserver\dataalle\Kundeservice\Hurtigsvar makrotekster\Booking ny ordre.oft")

replyEmail.To = origEmail.Reply.To
replyEmail.CC = origEmail.CC

replyEmail.HTMLBody = replyEmail.HTMLBody & origEmail.Reply.HTMLBody
replyEmail.SentOnBehalfOfName = "kundeservice@autologik.dk"
replyEmail.Recipients.ResolveAll
replyEmail.Subject = origEmail.Subject & " Din ordre er nu booket"
replyEmail.Display

Set origEmail = Nothing
Set replyEmail = Nothing

End Sub

What am i doing wrong ?

See attached error

 

[Madsfrost]

@Diane Poremsky I got the insert macro from your post. Maybe you can help me here ?