Change behavior of outlook (Reply and Reply All) itself, to add attachments from the original email to the replied message

Question

As you know while you are using outlook and use (Reply/ Reply All) to an email message, the original attachments is not included on the replied message.
So, I have used the below code and assigned to a custom buttons on outlook ribbon, and it works correctly.
Instead of click on my custom button, I need to assign my code directly to outlook inbuilt functions itself (Reply and Reply All) .
I found that outlook provides two events for oMailItem Object oMailItem_Reply and oMailItem_ReplyAll.
I have used it like this:

Private Sub oMailItem_Reply(ByVal Response As Object, Cancel As Boolean)
    Call ReplyWithAttachments
End Sub
 
Private Sub oMailItem_ReplyAll(ByVal Response As Object, Cancel As Boolean)
   Call ReplyAllWithAttachments
End Sub

But when I click on outlook (Reply and Reply All) itself, then either one from the following behavior happens:
1- a new replied email created without any attachments at all ,
2- Or the new replied email created twice , one with attachments included and the other one without any attachments.
This is the full working code to add the attachments from the original email to the replied one:

Option Explicit
Option Compare Text
Sub ReplyWithAttachments()
    ReplyAndAttach (False)
End Sub
Sub ReplyAllWithAttachments()
    ReplyAndAttach (True)
End Sub
 
Function GetCurrentItem() As Object
 
    Dim objApp As Outlook.Application
 
    Set objApp = Application
'  On Error Resume Next
    Select Case TypeName(objApp.ActiveWindow)
        Case "Explorer"
            Set GetCurrentItem = objApp.ActiveExplorer.Selection.Item(1)
        Case "Inspector"
            Set GetCurrentItem = objApp.ActiveInspector.CurrentItem
    End Select
 
    Set objApp = Nothing
End Function
 
Sub AddOriginalAttachments(ByVal myItem As Object, ByVal myResponse As Object)
 
    Dim fldTemp As Object, strPath As String, strFile As String
    Dim myAttachments As Variant, attach As Attachment
 
    Set myAttachments = myResponse.Attachments
 
    Dim fso As New FileSystemObject
 
    Set fldTemp = fso.GetSpecialFolder(2)    'User Temp Folder
    strPath = fldTemp.Path & "\"
 
    For Each attach In myItem.Attachments
      If Not attach.FileName Like "*image###.png" And _
         Not attach.FileName Like "*image###.jpg" And _
         Not attach.FileName Like "*image###.gif" Then
        strFile = strPath & attach.FileName
         attach.SaveAsFile strFile
          myAttachments.Add strFile, , , attach.DisplayName
           fso.DeleteFile strFile
      End If
    Next
 
    Set fldTemp = Nothing
    Set fso = Nothing
    Set myAttachments = Nothing
End Sub
 
Sub ReplyAndAttach(ByVal ReplyAll As Boolean)
 
    Dim myItem As Outlook.MailItem
    Dim oReply As Outlook.MailItem
 
    Set myItem = GetCurrentItem()
 
    If Not myItem Is Nothing Then
        If ReplyAll = False Then
            Set oReply = myItem.Reply
        Else
            Set oReply = myItem.ReplyAll
        End If
 
        AddOriginalAttachments myItem, oReply
        oReply.Display
        myItem.UnRead = False
    End If
 
    Set oReply = Nothing
    Set myItem = Nothing
End Sub

Answer 1

1. Please, copy the next declarations in the top part (declarations area) of ThisOutlookSession code module:

  'new variables: _________________________________
  Private WithEvents myExplorer As Outlook.Explorer
  Private WithEvents myitemExpl As Outlook.MailItem
  '________________________________________________

  Private WithEvents MyItem As Outlook.MailItem
  Private WithEvents m_Inspectors As Outlook.Inspectors
  Private WithEvents m_Inspector As Outlook.Inspector

  Private Const boolNoAttach As Boolean = True 'make it true when need to add original attachments

2. Copy the next code events (and two Subs), or add the next code lines if the respective event already exists:

 Private Sub Application_Startup() 'it may exist, I suggested it in another answer for you
     Set m_Inspectors = Application.Inspectors
     Set myExplorer = Application.ActiveExplorer
End Sub

'the next one may also exist, I think (if you did not delete it):
Private Sub m_Inspectors_NewInspector(ByVal Inspector As Outlook.Inspector)
    If TypeOf Inspector.CurrentItem Is Outlook.MailItem Then
       'Handle emails only
       Set m_Inspector = Inspector
    End If
End Sub

Private Sub m_Inspector_Activate()
  'existing declarations, if any
  '.......
 If TypeOf m_Inspector.CurrentItem Is MailItem Then
   Set MyItem = m_Inspector.CurrentItem 'it looks volatile and may be lost after using once...
   'existing code, if any...
 End if
End Sub

Private Sub myItem_PropertyChange(ByVal Name As String)
    'your existing code, if any...
    Initialize_Handler
End Sub

Sub Initialize_Handler()
 Set MyItem = Application.ActiveInspector.CurrentItem
 Set myExplorer = Application.ActiveExplorer 'new line for Explorer issues handling
End Sub

Private Sub MyItem_Reply(ByVal Response As Object, Cancel As Boolean)
  If boolNoAttach Then 'only if this constant is True
    AddOrigAttachments MyItem, Response
  End If
End Sub

Private Sub MyItem_ReplyAll(ByVal Response As Object, Cancel As Boolean)
   If boolNoAttach Then 'only if this constant is True
      AddOrigAttachments MyItem, Response
   End If
End Sub

'part dealing with Explorer issues handling:
Private Sub myExplorer_SelectionChange()
 On Error Resume Next
 Set myitemExpl = myExplorer.Selection.Item(1)
End Sub

Private Sub myitemExpl_Reply(ByVal Response As Object, Cancel As Boolean)
  If boolNoAttach Then 'only if this constant is True
    AddOrigAttachments myitemExpl, Response
  End If
End Sub
Private Sub myitemExpl_ReplyAll(ByVal Response As Object, Cancel As Boolean)
  If boolNoAttach Then 'only if this constant is True
      AddOrigAttachments myitemExpl, Response
  End If
End Sub

Sub AddOrigAttachments(ByVal MyItem As Object, ByVal myResponse As Object)
    Dim MyAttachments As Variant
    Set MyAttachments = myResponse.Attachments
    
    Dim fso As Object, fldTemp As Object, strPath As String, Attachment As Outlook.Attachment, strFile As String
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set fldTemp = fso.GetSpecialFolder(2)  'User Temp Folder
    strPath = fldTemp.Path & "\"
 
    For Each Attachment In MyItem.Attachments
        strFile = strPath & Attachment.FileName
        Attachment.SaveAsFile strFile
        MyAttachments.Add strFile, , , Attachment.DisplayName
        fso.DeleteFile strFile
    Next
    
    Set fldTemp = Nothing
    Set fso = Nothing
    Set MyAttachments = Nothing
End Sub

This last one may also stay in a standard module. I made some tests and I do not remember if I modified somehow your existing Sub with a similar name...

Answer 2

This code assumes the last item selected will be replied to, whether opened first or not.

An inspector event is probably unnecessary.

Option Explicit

Private WithEvents myAttExp As explorer
Private WithEvents myAttOriginatorMail As MailItem
  
Private Sub Application_Startup()
    ' No need for a separate Initialize_Handler in ThisOutlookSession
    Set myAttExp = ActiveExplorer
End Sub

Private Sub myAttOriginatorMail_Reply(ByVal Response As Object, Cancel As Boolean)
    AddOrigAttachments myAttOriginatorMail, Response
End Sub

Private Sub myAttOriginatorMail_ReplyAll(ByVal Response As Object, Cancel As Boolean)
    AddOrigAttachments myAttOriginatorMail, Response
End Sub


Private Sub myAttExp_SelectionChange()

    ' An error occurs when there is a folder change.
    ' For reasons unknown, this addresses the error.
    On Error Resume Next
    
    If TypeOf myAttExp.selection.Item(1) Is MailItem Then
        Set myAttOriginatorMail = myAttExp.selection.Item(1)
        Debug.Print myAttOriginatorMail.subject
    End If
    
End Sub


Sub AddOrigAttachments(ByVal myOrigMail As Object, ByVal myResponse As Object)

    Dim fso As Object
    Dim fldTemp As Object
    
    Dim strPath As String
    Dim strFile As String
    
    Dim Att As Attachment
    
    Dim myAttachments As Attachments
    Set myAttachments = myOrigMail.Attachments
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set fldTemp = fso.GetSpecialFolder(2)  'User Temp Folder
    Debug.Print fldTemp
    
    strPath = fldTemp.path & "\"
 
    For Each Att In myAttachments
        strFile = strPath & Att.FileName
        Debug.Print strFile
        
        Att.SaveAsFile strFile
        
        myResponse.Attachments.Add strFile, , , Att.DisplayName
        fso.DeleteFile strFile
    Next
    
End Sub