我有一个脚本在outlook 2010中做得很好，但自升级到Outlook 2013以来，它崩溃了很多不同的点。我想知道是否有其他人有办法做到这一点或者能看出它是否可以修复？
似乎在一些olDocument，oInspector，ActiveInspector.WordEditor.Application步骤中崩溃，取决于风的吹动方式。
感谢您的帮助
Option Explicit
Private WithEvents oExpl As Explorer
Private WithEvents oItem As MailItem
Private bDiscardEvents, Cancel As Boolean
Private strAtt, FinalMsg As String
Private oAtt As Attachment
Private oResponse As MailItem
'This sub inserts the name of any meaningful attachments just after the signature
Private Sub Application_ItemSend(ByVal item As Object, Cancel As Boolean)
Dim oAtt As Attachment
Dim strAtt, DateMark, ShortTime, FinalMsg, AttachName, TriggerText As String
Dim olInspector, oInspector As Inspector
Dim olDocument As Object
Dim olSelection As Object
Dim NewMail As MailItem
Dim AttchCount, i As Integer
Exit Sub
TriggerText = "Joe Bloggs"
If oInspector Is Nothing Then
'Set NewMail = Application.ActiveExplorer.Selection.Item(1)
Set NewMail = oExpl.ActiveInlineResponse
If NewMail Is Nothing Then
'MsgBox "No active inspector or inline response"
Exit Sub
End If
Else
Set NewMail = oInspector.CurrentItem
End If 'oInspector is Nothing
Set oInspector = Application.ActiveInspector
If oInspector.CurrentItem.Class = olAppointment Then End
With NewMail
AttchCount = .Attachments.Count
If AttchCount > 0 Then
For i = 1 To AttchCount
AttachName = .Attachments.item(i).DisplayName
If InStr(LCase(AttachName), "pdf") <> 0 Or InStr(LCase(AttachName), "xls") <> 0 Or InStr(LCase(AttachName), "doc") <> 0 Or InStr(LCase(AttachName), "ppt") <> 0 Or InStr(LCase(AttachName), "msg") <> 0 Or .Attachments.item(i).Size > 95200 Then
strAtt = strAtt & "<<" & AttachName & ">> " & vbNewLine
End If
Next i
End If
End With
' this section is an alternative method of getting attachment names
'For Each oAtt In Item.Attachments
' If InStr(oAtt.FileName, "xls") <> 0 Or InStr(oAtt.FileName, "doc") <> 0 Or InStr(oAtt.FileName, "pdf") <> 0 Or InStr(oAtt.FileName, "ppt") <> 0 Or InStr(oAtt.FileName, "msg") <> 0 Or oAtt.Size > 95200 Then
' strAtt = strAtt & "<<" & oAtt.FileName & ">> " & vbNewLine
'End If
'Next
'Set olInspector = Application.ActiveInspector()
'Set olDocument = olInspector.WordEditor
'Set olSelection = olDocument.Application.Selection
DateMark = "" '" (dated " & Date & ")" 'Date not necessary now this is working well
If strAtt = "" Then
FinalMsg = ""
Exit Sub
Else
FinalMsg = "Documents attached to this email" & DateMark & ": " & vbNewLine & strAtt
End If
Dim inputArea, SearchTerm As String
Dim SignatureLine, FromLine, EndOfEmail As Integer
'Find the end of the signature
With ActiveInspector.WordEditor.Application 'Might be able to use: Application.ActiveWindow.CurrentItem
.Selection.WholeStory
.Selection.Find.ClearFormatting
With .Selection.Find
.Text = TriggerText
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindAsk
.Format = False
.MatchCase = False
.Execute
End With
SignatureLine = .Selection.Range.Information(wdFirstCharacterLineNumber) + 1
.Selection.EndKey Unit:=wdLine
End With
'check to see if attachment info has already been added
With ActiveInspector.WordEditor.Application
.Selection.MoveDown Unit:=wdLine, Count:=3, Extend:=wdExtend
inputArea = .Selection
.Selection.HomeKey Unit:=wdLine
.Selection.EndKey Unit:=wdLine
'SelectedLine = .Selection.Range.Information(wdFirstCharacterLineNumber) + 1
'detect existing attachment lists
If Not InStr(inputArea, "Documents attached to this email") <> 0 Then
.Selection.EndKey Unit:=wdLine
.Selection.TypeParagraph
Else
With .Selection.Find
.Text = "From:"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindAsk
.Format = False
.MatchCase = True
.Execute
End With
FromLine = .Selection.Range.Information(wdFirstCharacterLineNumber) + 1
'In case the email being replied to is not in english,
'try to detect the first line of the next email by looking for mailto
If .Selection.Find.Found = False Then
With .Selection.Find
.Text = ">>"
.Replacement.Text = ""
.Forward = False
.Wrap = wdFindAsk
.Format = False
.Execute
End With
End If
'designate the last line of the email and delete anything between this and the signature
EndOfEmail = .Selection.Range.Information(wdFirstCharacterLineNumber) - 1
.Selection.MoveUp Unit:=wdLine, Count:=1, Extend:=wdExtend
.Selection.EndKey Unit:=wdLine
.Selection.MoveUp Unit:=wdLine, Count:=EndOfEmail - SignatureLine, Extend:=wdExtend
.Selection.Expand wdLine
.Selection.Delete
End If
End With
'Insert the text and format it.
If Not NewMail.BodyFormat = olFormatPlain Then
With ActiveInspector.WordEditor.Application
.Selection.TypeParagraph
.Selection.InsertAfter FinalMsg 'insert the message at the cursor.
.Selection.Font.Name = "Calibri"
.Selection.Font.Size = 8
.Selection.Font.Color = wdColorBlack
.Selection.EndKey Unit:=wdLine
'If FromLine - EndOfEmail < 2 Then .Selection.TypeParagraph
'.Selection.Delete
End With
End If
lastline:
End Sub
答案 0 :(得分：1)
您传递“作为对象的项目”，因此您无需再次找到它。
Private Sub Application_ItemSend(ByVal item As Object, cancel As Boolean)
Dim oAtt As attachment
Dim strAtt, DateMark, ShortTime, FinalMsg, AttachName, TriggerText As String
'Dim olInspector, oInspector As Inspector
Dim olDocument As Object
Dim olSelection As Object
Dim NewMail As MailItem
Dim AttchCount, i As Integer
TriggerText = "Joe Bloggs"
'If oInspector Is Nothing Then
' 'Set NewMail = Application.ActiveExplorer.Selection.Item(1)
' Set NewMail = oExpl.ActiveInlineResponse
' If NewMail Is Nothing Then
' 'MsgBox "No active inspector or inline response"
' Exit Sub
' End If
'Else
' Set NewMail = oInspector.currentItem
'End If 'oInspector is Nothing
'Set oInspector = Application.ActiveInspector
'If oInspector.currentItem.Class = olAppointment Then End
If TypeOf item Is MailItem Then
Set NewMail = item
With NewMail ' In future coding you need not bother to set NewMail just use item
答案 1 :(得分：0)
您需要使用Body或HTMLBody属性在ItemSend事件处理程序中自定义消息正文。 Word编辑器可能在此阶段不可用，即可能为时已晚。此外，不保存使用Send或ItemSend事件中的WordEditor属性所做的更改。有关详细信息，请查看描述的similar issue。