如何修复 Outlook 脚本规则错误

Question

我正在尝试运行我的代码使用规则脚本只处理新到达的消息，但它一直抛出错误

我的代码哪里做错了？

Option Explicit
Public Sub Test(Item As Outlook.MailItem)
    Dim xlApp As Excel.Application
    Dim xlWB As Excel.Workbook
    Dim xlSheet As Excel.Worksheet
    Dim vText As Variant
    Dim sText As String
    Dim vItem As Variant
    Dim i As Long
    Dim rCount As Long
    Dim XStarted As Boolean
    Dim FileName As String
    Dim FilePath As String '// SaveAs CSV File Path
    Dim sPath As String '// .CSV File Path

    '// the path of the workbook
    sPath = "C:\temp\temp.csv"

    On Error Resume Next
    Set xlApp = GetObject(, "Excel.Application")

    If Err <> 0 Then
        Application.StatusBar = "Please wait while Excel source is opened ... "
        Set xlApp = CreateObject("Excel.Application")
        XStarted = True
    End If

'    On Error GoTo 0
    '// Open the workbook to input the data
    Set xlWB = xlApp.Workbooks.Open(sPath)
    Set xlSheet = xlWB.Sheets("Report")

    '// Process received Mail
    sText = Item.Body
    vText = Split(sText, Chr(13)) ' Chr(13)) carriage return

    '// Find the next empty line of the worksheet
    rCount = xlSheet.Range("B" & xlSheet.Rows.Count).End(xlUp).Row
    rCount = rCount + 1

    '// Check each line of text in the message body
    For i = UBound(vText) To 0 Step -1

        '// Customer Name
        If InStr(1, vText(i), "Customer") > 0 Then
            vItem = Split(vText(i), Chr(9)) ' Chr(9) horizontal tab
            xlSheet.Range("A" & rCount) = Trim(vItem(1))
        End If

        '// Ref Number
        If InStr(1, vText(i), "Order #") > 0 Then
            vItem = Split(vText(i), Chr(9))
            xlSheet.Range("B" & rCount) = Trim(vItem(1))
        End If

        '// Service Level
        If InStr(1, vText(i), "Service Level") > 0 Then
            vItem = Split(vText(i), Chr(9))
            xlSheet.Range("J" & rCount) = Trim(vItem(1))
        End If
    Next i
    FilePath = Environ("USERPROFILE") & "\Documents\Temp\"
    FileName = Sheets(1).Range("B2").Value
    xlWB.SaveAs FileName:=FilePath & FileName

    '// Close & SaveChanges
    xlWB.Close SaveChanges:=True
    If XStarted Then
        xlApp.Quit
    End If

    Set xlApp = Nothing
    Set xlWB = Nothing
    Set xlSheet = Nothing
    Set Item = Nothing
 End Sub

Answer 1

帕特里克

您可能更改了 VBA 项目名称。转到 Outlook 规则，编辑，re-assign 宏。

此外，它应该 FileName = xlWB.Sheets(1).Range("B2").Value 并去掉 Application.StatusBar = ...

谢谢...

如何修复 Outlook 脚本规则错误

How to fix Outlook script rule Error

outlook

vba

outlook-2010