Outlook toplu mail yanıtlama macrosu sorunu

[KAIZEN1]

Merhabalar,

Toplu mail yanıtlamada same reply tuşunu sub ile bağlantısını yapamadım tıkladığımda butona çalışmıyor, yardımlarınızı rica ederim.


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)

'Add a "Same Reply" option to the context menu
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

'Input the name of the previously saved template
strTemplate = InputBox("Enter the name of template message:", , "FATURANIZ ULAŞTIĞINA DAİR BİLGİ TALEBİ")
Set objTemplateReply = Application.CreateItemFromTemplate("C:\Users\murat.kaya\AppData\Roaming\Microsoft\Templates\" & 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