我在很多场合都引用了该站点的很多内容，并且几乎总是找到答案。但是，这次，我已经完全用尽了解决这个问题的能力。
我对Outlook VBA还是很陌生，发现并调整了一些脚本以适合我的应用程序，这些脚本在满足规则条件时运行，并且可以自动运行。
虽然我有一个脚本，但是当合格的电子邮件触发规则时失败，但是奇怪的是，如果手动运行它可以很好地运行，所以我知道代码是好的。
让我感到困惑的是，为什么我的所有规则（包括运行脚本的规则）会自动运行正常，除了NumberedReply（本质上它会自动回复发件人，并使用从电子表格中提取的运行中唯一编号）。 >
我已尽力找到所有可能的东西。仅举几例：
-数字签名宏（并添加到受信任的证书）
-在和退出安全模式以及在OWA上删除和重新制作规则
-将宏安全性更改为每个选项
-保存带有保存按钮的宏，而不仅仅是关闭并接受对话框
-运行scanpst.exe并重命名Outlook.srs文件。
这是失败的脚本：
Sub NumberedReply(olItem As Outlook.MailItem)
Dim olOutMail As MailItem
Dim xlApp As Object
Dim xlWB As Object
Dim xlSheet As Object
Dim iLastRow As Long
Dim bXstarted As Boolean
Dim iNumber As Integer
Const strPath As String = "O:\Logistics\Quoting\Quote Tracker 1.6.xlsx" 'the path of the workbook
Const strMessage As String = "Your request has been received. Rate Request ID: " ' The reply message
On Error Resume Next
Set xlApp = GetObject("Excel.Application")
If Err <> 0 Then
Application.StatusBar = "Please wait while Excel log is opened ... "
Set xlApp = CreateObject("Excel.Application")
bXstarted = True
End If
On Error GoTo 0
'Open the workbook to input the data
Set xlWB = xlApp.Workbooks.Open(strPath)
Set xlSheet = xlWB.Sheets("Data")
iLastRow = xlSheet.Range("A" & xlSheet.Rows.count).End(-4162).Row
Select Case iLastRow
Case Is = 1
If xlSheet.Range("A1") = "" Then
xlSheet.Range("I1") = olItem.ReceivedTime
xlSheet.Range("J1") = olItem.ReceivedTime
xlSheet.Range("E1") = olItem.Sender
xlSheet.Range("A1") = 1
iNumber = 1
Else
xlSheet.Range("I" & iLastRow + 1) = olItem.ReceivedTime
xlSheet.Range("J" & iLastRow + 1) = olItem.ReceivedTime
xlSheet.Range("E" & iLastRow + 1) = olItem.Sender
xlSheet.Range("A" & iLastRow + 1) = xlSheet.Range("A" & iLastRow) + 1
iNumber = Val(xlSheet.Range("A" & iLastRow + 1))
End If
Case Else
xlSheet.Range("I" & iLastRow + 1) = olItem.ReceivedTime
xlSheet.Range("J" & iLastRow + 1) = olItem.ReceivedTime
xlSheet.Range("E" & iLastRow + 1) = olItem.Sender
xlSheet.Range("A" & iLastRow + 1) = xlSheet.Range("A" & iLastRow) + 1
iNumber = Val(xlSheet.Range("A" & iLastRow + 1))
End Select
Set olOutMail = Application.CreateItem(0)
With olOutMail
.To = olItem.SenderEmailAddress
.Subject = "RE: Completed Rate Request Form - Rate Request ID: " & iNumber
.Body = strMessage & iNumber
.Send 'Change to .Send after testing to go live 'Change to .Display for testing
End With
xlWB.Close SaveChanges:=True
If bXstarted Then xlApp.Quit
Set olOutMail = Nothing
Set xlSheet = Nothing
Set xlWB = Nothing
Set xlApp = Nothing
End Sub
编辑
-我所有的规则都是客户端
-失败，是指触发规则时出现“错误规则”框，指出哪个规则失败和错误，并显示“操作失败”。 （具有讽刺意味的是，我在编辑此帖子之前再次对其进行了测试，并且它的工作原理……一次……现在再次失败）
-这是我的规则之一的示例，该规则调用一个每次触发都运行良好的脚本：
Public Sub Overview(Item As Outlook.MailItem)
'This will open the Overview report from the email, delete Rows 1 and 2, delete column A,
'then save to the Data - Gauss Reports folder, and overwrite the existing file
If Item.Attachments.count > 0 Then
Dim objAttachments As Outlook.Attachments
Dim lngCount As Long
Dim strFile As String
Dim sFileType As String
Dim i As Long
Set objAttachments = Item.Attachments
lngCount = objAttachments.count
For i = lngCount To 1 Step -1
'Get the file name
strFile = objAttachments.Item(i).FileName
'Get the path to your Downloads folder
strfolderpath = "C:\Users\username\Downloads\"
'Combine with the path to the folder
strFile = strfolderpath & strFile
'Save the attachment as a file
objAttachments.Item(i).SaveAsFile strFile
Next i
End If
'Opens Excel
On Error Resume Next
Set xlApp = GetObject(, "Excel.Application")
If xlApp Is Nothing Then Set xlApp = CreateObject("Excel.Application")
On Error GoTo 0
xlApp.Visible = False
'Opens Personal Workbook so Excel can access the macro to edit and save report as correct file type
On Error Resume Next
Set xlWB1 = xlApp.Workbooks("C:\Users\username\AppData\Roaming\Microsoft\Excel\XLSTART\PERSONAL.XLSB")
If xlWB1 Is Nothing Then Set xlWB1 = xlApp.Workbooks.Open("C:\Users\username\AppData\Roaming\Microsoft\Excel\XLSTART\PERSONAL.XLSB")
'Opens Overview report for editing
Set xlWB2 = xlApp.Workbooks("C:\Users\username\Downloads\Overview.xls")
If xlWB2 Is Nothing Then Set xlWB2 = xlApp.Workbooks.Open("C:\Users\username\Downloads\Overview.xls")
On Error GoTo 0
'Runs macro to edit and save report
xlWB2.Application.Run "PERSONAL.XLSB!QTS_Overview"
'Closes Excel
xlApp.Quit
'Clears defined objects from memory
Set xlWB1 = Nothing
Set xlWB2 = Nothing
Set xlApp = Nothing
'Deletes originally saved "Overview" file that was edited then saved previously
On Error Resume Next
aFile = "C:\Users\username\Downloads\Overview.xls"
Kill aFile
On Error GoTo 0
End Sub