Sub Application_ItemContextMenuDisplay(ByVal CommandBar As Office.CommandBar, ByVal Selection As Selection)
Dim objCommandBarButton As Office.CommandBarButton
If (Selection.Count > 1) And (Selection.Item(1).Class = olMail) Then
Set objCommandBarButton = CommandBar.Controls.Add(msoControlButton)
With objCommandBarButton
.Style = msoButtonIconAndCaption
.Caption = "Same Reply"
.FaceId = 355
.OnAction = "Project1.ThisOutlookSession.SendSameReply"
End With
End If
End Sub
Sub SendSameReply()
Dim strTemplate As String
Dim objTemplateReply As Outlook.MailItem
Dim strHTMLBody As String
Dim objSelection As Outlook.Selection
Dim i As Long
Dim objReply As Outlook.MailItem
strTemplate = InputBox("Enter the name of template message:", , "Template Reply")
Set objTemplateReply = Application.CreateItemFromTemplate("Q:\Outlook-Vorlagen\" & strTemplate & ".oft")
strHTMLBody = objTemplateReply.HTMLBody
Set objSelection = Application.ActiveExplorer.Selection
For i = objSelection.Count To 1 Step -1
Set objReply = objSelection(i).Reply
With objReply
.HTMLBody = strHTMLBody & objReply.HTMLBody
.Send
End With
Next
End Sub