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

Question

我有一个脚本，用来列出我正在回复的电子邮件中的附件。自上次调整以来，它已经运行了几天，但今天它在到达End Sub行时开始打开一个额外的回复窗口。我试着把它重置为上周的样子，但它仍然有效。我想这只是我意外打开的一个选项。

' 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

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