从目标Excel工作簿运行VBA代码触发Error 91问题排查

Let's break down why you're hitting that Runtime Error 91 and fix it step by step.

What's Causing the Error? #

When you run the code from the target workbook itself, the line Set xlWB = xlApp.Workbooks.Open(strPath) tries to open a file that's already open. Excel blocks duplicate open attempts for the same file in one instance, so xlWB ends up as Nothing—hence the error when you try to reference its "IMPORT" sheet.

When you run from Outlook or another workbook, the target file isn't open in that Excel instance, so Workbooks.Open works correctly and sets xlWB properly.

Modified Code with Fixes #

Here's the adjusted code that handles both scenarios (target workbook open or closed) when running from within the target file:

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 Excel.Application
    Dim xlWB As Excel.Workbook
    Dim xlSheet As Excel.Worksheet
    Dim vText As Variant
    Dim sText As String
    Dim rCount As Long
    Dim bXStarted As Boolean
    Dim strPath As String
    Dim Reg1 As Object
    Dim M1 As Object
    Dim M As Object
    
    ' Use ThisWorkbook to get the path of the file running the code (no hardcoding!)
    strPath = ThisWorkbook.FullName
    
    ' Get existing Excel instance or create a new one
    On Error Resume Next
    Set xlApp = GetObject(, "Excel.Application")
    If Err <> 0 Then
        Set xlApp = New Excel.Application
        bXStarted = True
    End If
    On Error GoTo 0
    
    ' Check if the workbook is already open to avoid duplicate open attempt
    On Error Resume Next
    Set xlWB = xlApp.Workbooks(ThisWorkbook.Name)
    If Err <> 0 Then
        ' Workbook wasn't open, so open it now
        Set xlWB = xlApp.Workbooks.Open(strPath)
    End If
    On Error GoTo 0
    
    ' Verify the IMPORT sheet exists before proceeding
    On Error Resume Next
    Set xlSheet = xlWB.Sheets("IMPORT")
    On Error GoTo 0
    If xlSheet Is Nothing Then
        MsgBox "Sheet 'IMPORT' not found in the workbook!", vbCritical
        GoTo Cleanup
    End If
    
    ' Calculate starting row in column Q
    rCount = xlSheet.Range("Q" & xlSheet.Rows.Count).End(xlUp).Row + 1
    
    ' Connect to Outlook and target folder
    Set objOL = New Outlook.Application
    Set objFolder = objOL.Session.GetDefaultFolder(olFolderInbox).Parent.Folders("Data").Folders("Register")
    Set objItems = objFolder.Items
    
    ' Process each mail item in the folder
    For Each olItem In objItems
        ' Skip non-mail items (like meetings, tasks) to avoid errors
        If olItem.Class = olMail Then
            sText = olItem.Body
            Set Reg1 = CreateObject("VBScript.RegExp")
            With Reg1
                .Pattern = "(OPO\/\d{2}\/[CLRPWBDFGIMSKT]\/\S{10}\/[SO|DL|MM]{2}\/\d{3})"
                .Global = False ' Match once per email (change to True if you need multiple matches)
            End With
            
            If Reg1.test(sText) Then
                Set M1 = Reg1.Execute(sText)
                ' Get the full matched string (no need for SubMatches here)
                vText = Trim(M1(0).Value)
                xlSheet.Range("Q" & rCount).Value = vText
                rCount = rCount + 1
            End If
        End If
    Next olItem
    
    ' Save changes only if we opened the workbook (don't overwrite unsaved changes if it was already open)
    If Err.Number = 0 Then
        xlWB.Save
    End If
    xlWB.Close SaveChanges:=False

Cleanup:
    ' Clean up all objects to avoid memory leaks
    Set M = Nothing
    Set M1 = Nothing
    Set Reg1 = Nothing
    Set xlSheet = Nothing
    Set xlWB = Nothing
    If bXStarted Then xlApp.Quit
    Set xlApp = Nothing
    Set objItems = Nothing
    Set objFolder = Nothing
    Set objOL = Nothing
    
    MsgBox "String extraction completed successfully!", vbInformation
End Sub

Key Fixes & Improvements #

• Handle Open Workbook: We first check if the target workbook is already open using xlApp.Workbooks(ThisWorkbook.Name) instead of blindly calling Workbooks.Open, which fixes the root cause of the error.
• Dynamic Path: ThisWorkbook.FullName automatically gets the path of the file running the code, eliminating hardcoded paths that can break if the file moves.
• Explicit Object Types: Using Excel.Application/Excel.Workbook instead of generic Object gives better intellisense and early error checking (since you've referenced the Outlook library).
• Mail Item Filter: Added If olItem.Class = olMail Then to skip non-mail items in the folder, preventing unexpected errors.
• Missing Sheet Check: Added a safety check to ensure the "IMPORT" sheet exists, with a clear message if it doesn't.
• Cleanup: Centralized object cleanup in a Cleanup section to ensure all resources are released even if an error occurs.

内容的提问来源于stack exchange，提问作者Rayearth