Question

我使用了https://www.slipstick.com/developer/vba-copy-outlook-email-excel-workbook/中的出色代码，并针对我的情况对其进行了修改，以从电子邮件正文中提取字符串。

在包括MS Outlook 16.0 Object Lib之后，我从目标Excel工作簿中运行了它，而不是在Outlook中使用它。

我发誓我第一次启动它时就起作用了，但是那天晚些时候，我收到了运行时错误91-“未设置对象变量或With块变量”在行上

Set xlSheet = xlWB.Sheets("IMPORT")

我设法推断出此错误仅在从目标工作簿启动代码时发生。从Outlook或其他工作簿中启动时，它工作正常。

在这种情况下出现此类错误的原因可能是什么？

Option Explicit
Private Const xlUp As Long = -4162

Sub Extract_string_from_email_body()
    Dim objOL As Outlook.Application
    Dim objItems As Outlook.Items
    Dim objFolder As Outlook.MAPIFolder
    Dim olItem As Outlook.MailItem
    Dim xlApp As Object
    Dim xlWB As Object
    Dim xlSheet As Object
    Dim vText, vText2, vText3, vText4, vText5 As Variant
    Dim sText As String
    Dim rCount As Long
    Dim bXStarted As Boolean
    Dim enviro As String
    Dim strPath As String
    Dim Reg1 As Object
    Dim M1 As Object
    Dim M As Object

    'original code to run from Outlook and output string to existing workbook
    'enviro = CStr(Environ("USERPROFILE"))
    'strPath = enviro & "\Documents\test.xlsx"

    'my target workbook I've launched my code from
    strPath = "X:\02 Workbooks\Workbook.xlsm"
    On Error Resume Next

    Set xlApp = GetObject(, "Excel.Application")

    If Err <> 0 Then
        Set xlApp = CreateObject("Excel.Application")
        bXStarted = True
    End If
    On Error GoTo 0

    Set xlWB = xlApp.Workbooks.Open(strPath)
    Set xlSheet = xlWB.Sheets("IMPORT") 'error occurs here

    rCount = xlSheet.Range("Q" & xlSheet.Rows.Count).End(xlUp).Row
    rCount = rCount + 1

    Set objOL = Outlook.Application
    Set objFolder = objOL.Session.GetDefaultFolder(olFolderInbox).Parent.Folders("Data").Folders("Register")
    Set objItems = objFolder.Items

    For Each olItem In objItems
        On Error Resume Next
        With olItem
            sText = olItem.Body

            Set Reg1 = CreateObject("VBScript.RegExp")

            With Reg1
                .Pattern = "((OPO\/\d{2}\/[CLRPWBDFGIMSKT]\/\S{10}\/[SO|DL|MM]{2}\/\d{3}))"
            End With

            If Reg1.test(sText) Then

                Set M1 = Reg1.Execute(sText)

                For Each M In M1
                    vText = Trim(M.SubMatches(1))

                Next

                xlSheet.Range("Q" & rCount) = vText

                rCount = rCount + 1

            End If
        End With
    Next

    xlWB.Close 1

    If bXStarted Then
        xlApp.Quit
    End If

    Set M = Nothing
    Set M1 = Nothing
    Set Reg1 = Nothing
    Set xlApp = Nothing
    Set xlWB = Nothing
    Set xlSheet = Nothing
    Set objItems = Nothing
    Set objFolder = Nothing
    Set objOL = Nothing
End Sub

Answer 1

首先，如果您在Excel中运行代码，则无需获取Excel Application实例或在代码中创建新实例：

Set xlApp = GetObject(, "Excel.Application")

    If Err <> 0 Then
        Set xlApp = CreateObject("Excel.Application")
        bXStarted = True
    End If
    On Error GoTo 0

直接使用VBA宏的Applicaiton属性。

第二，您需要正确初始化Outlook应用程序：

Set objOL = Outlook.Application

但是应该是：

Set objOL = New Outlook.Application

您可以在Automating Outlook from a Visual Basic Application文章中了解有关此内容的更多信息。

VBA对象变量或With块变量未设置-错误91

1 个答案: