Referencing sheet in same workbook as the code generates Error 91: Object variable or With block variable not set

Question

I used this code from https://www.slipstick.com/developer/vba-copy-outlook-email-excel-workbook/ and modified it to extract a string from email body.

Instead of using it in Outlook, I run it from my target Excel workbook after including the MS Outlook 16.0 Object Library.

It worked the first time I fired it, but later that day I received

run-time error 91 - "Object variable or With block variable not set"

on line

Set xlSheet = xlWB.Sheets("IMPORT")

I deduced this error occurs when code is launched from the target workbook. It works when fired from Outlook or different workbook.

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

I think it's because you are trying to .Open the workbook which is already open. So xlWB is set to nothing. If you are running directly from the workbook the line above the error should be Set xlWB = ThisWorkbook. — Malan Kriel

Eugene Astafiev Eugene Astafiev · Accepted Answer · 2019-07-09T12:51:08

First of all, if you run the code in Excel there is no need to get an Excel Application instance or create a new one in the code:

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

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

Use the Applicaiton property availble for VBA macros out of the box.

Second, you need to initialize the Outlook Application properly:

Set objOL = Outlook.Application

But it should be:

Set objOL = New Outlook.Application

You can read more about that in the Automating Outlook from a Visual Basic Application article.

Referencing sheet in same workbook as the code generates Error 91: Object variable or With block variable not set

1 Answers