VBA attachment naming script opens two replies

Question

I have a script which I use to list attachments in an email I am replying to. It has been working fine for a few days since I last adjusted it but today it has started opening an extra reply window when it reaches the End Sub line. I’ve tried resetting it to how it was last week but it still does it. I presume it’s just an option which I have accidentally switched on.

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

Dim FinalMsg As String
Dim olInspector As Outlook.Inspector
Dim olDocument As Word.Document
Dim olSelection As Word.Selection

If bDiscardEvents Or oItem.Attachments.Count = 0 Then
       Exit Sub
End If

'Cancel = True
bDiscardEvents = True
strAtt = ""

Dim AttNam As String
FinalMsg = ""
For Each oAtt In oItem.Attachments
AttNam = LCase(oAtt.FileName)
    If oAtt.Size > 5200 Then
        strAtt = strAtt & "<" & oAtt.FileName & ">, "
    End If
Next oAtt

If strAtt = "" Then Exit Sub
FinalMsg = "Attached" & ": " & strAtt

    Set oResponse = oItem.Reply
    oResponse.Display

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

 'Find the end of the signature
With ActiveInspector.WordEditor.Application
    .Selection.WholeStory
    .Selection.Find.ClearFormatting
    With .Selection.Find
        .Text = "Subject:"
        .Replacement.Text = ""
        .Forward = True
        .Execute
    End With

    Dim SubjectFont As String 'capture formatting details to allow blending
    Dim SubjectSize As Integer
    SubjectFont = .Selection.Font.Name
    SubjectSize = .Selection.Font.Size

    .Selection.MoveDown Unit:=wdLine, Count:=1, Extend:=wdMove
    .Selection.HomeKey Unit:=wdLine
    .Selection.EndKey Unit:=wdLine, Extend:=wdExtend
    If InStr(.Selection.Text, "mportance") <> 0 Then
    .Selection.MoveDown Unit:=wdLine, Count:=1, Extend:=wdMove
    End If

End With

olSelection.InsertBefore FinalMsg


bDiscardEvents = False
Set oItem = Nothing
End Sub

Answer 1

The problem was caused by commenting out Cancel = True which presumably cancels the original procedure. Re-enabling this causes the script to only open the reply opened by oResponse.Display