0
У меня есть сценарий, который я использую для отображения вложений в электронном письме, на которое я отвечаю. Он работает отлично в течение нескольких дней с тех пор, как я последний раз его корректировал, но сегодня он начал открывать дополнительное окно ответа, когда он достигает линии End Sub. Я попробовал сбросить его до того, как он был на прошлой неделе, но он все еще это делает. Я предполагаю, что это просто вариант, который я случайно включил.Скрипт имен вложений 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