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

打开的回复

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

1 个答案: