VBA附件命名脚本打开两个回复

我有一个脚本，我用它在我回复的电子邮件中列出附件。自从我上次调整它以来，它已经工作了好几天了，但今天当它到达末尾子行时，它开始打开一个额外的回复窗口。我试着将它重置为上周的状态，但它仍然可以。我想这只是我不小心打开的一个选项

' 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

---

该问题是由注释掉Cancel=True引起的，这可能会取消原始过程。重新启用此选项将导致脚本仅打开由oResponse.Display打开的回复