Run time error 424: Object Required in Outlook/Excel VBA

I had this code working and after I put code in to automatically save the workbook on close I am getting this error.

This is the structure. I am autoprocessing emails I receive using a rule in outlook. The rule searches for new mail with a certain subject, moves it to a new folder, and runs a macro in outlook to copy the data from the email body to an excel file. The Excel file has an auto_open macro that appends the new data from each email to an access database, moves the data then to a new sheet, saves the workbook, and closes the file.

So when Outlook is processing the email it stops on this line:

Set xlSheet = xlWB.Sheets(1)

Full code:

Outlook

Option Explicit

Sub ProcessNewExpNote(olItem As Outlook.MailItem)

Dim xlApp As Object
Dim xlWB As Object
Dim xlSheet As Object
Dim vText As Variant
Dim sText As String
Dim vItem As Variant
Dim i As Long
Dim rCount As Long
Dim bXStarted As Boolean
Const strPath As String = "I:\My Documents\Projects\R2\Task 4 - GSDS Contractor DB\ProcessedReplies.xlsm"        'the path of the workbook


    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")
        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(1)

    'Process the message record
    sText = olItem.Body
    vText = Split(sText, Chr(13))
    'Find the next empty line of the worksheet
    rCount = xlSheet.Range("B" & xlSheet.Rows.Count).End(-4162).Row
    rCount = rCount + 1

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

        If InStr(1, vText(i), "Confirm Resource's Full Name:") > 0 Then
            vItem = Split(vText(i), Chr(58))
            xlSheet.Range("B" & rCount) = Trim(vItem(1))
        End If
        
        If InStr(1, vText(i), "Confirm Resource's SOEID:") > 0 Then
            vItem = Split(vText(i), Chr(58))
            xlSheet.Range("C" & rCount) = Trim(vItem(1))
        End If

        If InStr(1, vText(i), "Extending (Yes/No):") > 0 Then
            vItem = Split(vText(i), Chr(58))
            xlSheet.Range("D" & rCount) = Trim(vItem(1))
        End If

        If InStr(1, vText(i), "New End Date (or confirm current - mm/dd/yyyy):") > 0 Then
            vItem = Split(vText(i), Chr(58))
            xlSheet.Range("E" & rCount) = Trim(vItem(1))
        End If
        
        If InStr(1, vText(i), "GOC (if extending):") > 0 Then
            vItem = Split(vText(i), Chr(58))
            xlSheet.Range("F" & rCount) = Trim(vItem(1))
        End If

        If InStr(1, vText(i), "In Forecast (Yes/No):") > 0 Then
            vItem = Split(vText(i), Chr(58))
            xlSheet.Range("G" & rCount) = Trim(vItem(1))
        End If

        If InStr(1, vText(i), "Manager Approved (Yes/No):") > 0 Then
            vItem = Split(vText(i), Chr(58))
            xlSheet.Range("H" & rCount) = Trim(vItem(1))
        End If
        
        xlSheet.Range("I" & rCount) = olItem.SenderName
        xlSheet.Range("J" & rCount) = Date
        
    Next i
    xlWB.Close
    If bXStarted Then
        xlApp.Quit
    End If
    Set xlApp = Nothing
    Set xlWB = Nothing
    Set xlSheet = Nothing


End Sub

Excel code in workbook:

Private Sub Workbook_Open()

If Worksheets("data").Range("C2").Value = "" Then
        Application.Wait (Now + TimeValue("0:00:03"))
End If
    
Call Export
    
End Sub

Excel Code in module:

Option Explicit

Sub Export()

Dim cn As ADODB.Connection, rs As ADODB.Recordset
Dim resSOEID, resExt, resNewDate, newGOC, forecastConf, manAppConf, confFrom, confReceived As String
Dim NextRow As String
Dim ws2 As Worksheet
    Set ws2 = ThisWorkbook.Sheets("archived")
Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets("data")
Dim iRow As Integer
    iRow = 1

Application.DisplayAlerts = False

' connect to the Access database
Set cn = New ADODB.Connection
cn.Open "Provider=Microsoft.ACE.OLEDB.12.0; " & _
    "Data Source=I:\My Documents\Projects\R2\Task 4 - GSDS Contractor DB\DB.mdb;"
' open a recordset
Set rs = New ADODB.Recordset
rs.Open "Actions", cn, adOpenKeyset, adLockOptimistic, adCmdTable

Range("C2").Activate  ' row 1 contains column headings
Do While Not IsEmpty(ActiveCell)
    resSOEID = ActiveCell.Value
    resExt = ActiveCell.Offset(0, 1).Value
    resNewDate = ActiveCell.Offset(0, 2).Value
    newGOC = ActiveCell.Offset(0, 3).Value
    forecastConf = ActiveCell.Offset(0, 4).Value
    manAppConf = ActiveCell.Offset(0, 5).Value
    confFrom = ActiveCell.Offset(0, 6).Value
    confReceived = ActiveCell.Offset(0, 7).Value

    rs.Filter = "SOEID='" & resSOEID & "'"
    If rs.EOF Then
        Debug.Print "No existing record..."
    Else
        Debug.Print "Existing record found..."
    End If
    
        rs("Date of Confirmation").Value = confReceived
        rs("Manager Approval").Value = manAppConf
        rs("In Forecast").Value = forecastConf
        rs("Extending").Value = resExt
        rs("New Extension Date").Value = resNewDate
        rs("New GOC").Value = newGOC
        rs("Received From").Value = confFrom
    
        rs.Update
    
    Debug.Print "...record update complete."

    ActiveCell.Offset(1, 0).Activate  ' next cell down
Loop

rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing

ws2.Activate
Do While ws2.Cells(iRow, 3) <> ""
    iRow = iRow + 1
Loop

ws.Activate
ws.Range("B2:J2").Select
ws.Range("B2:J2").Copy

ws2.Activate
NextRow = ws2.Cells(iRow, 2).Address(RowAbsolute:=False, ColumnAbsolute:=False)
ws2.Range(NextRow & ":J" & iRow).PasteSpecial


ws.Activate
ws.Range("B2:J100").ClearContents
    If iRow > 1000 Then
        ws2.Activate
        ws2.Range("B2:J1001").ClearContents
    End If

ActiveWorkbook.Save
Application.DisplayAlerts = True
ActiveWorkbook.Close

End Sub

I haven't changed anything location or name wise with the excel file - just the macro within it. How would I isolate that?

No I'm pretty sure it was the last block of the excel code...

ws2.Activate
Do While ws2.Cells(iRow, 3) <> ""
    iRow = iRow + 1
Loop

ws.Activate
ws.Range("B2:J2").Select
ws.Range("B2:J2").Copy

ws2.Activate
NextRow = ws2.Cells(iRow, 2).Address(RowAbsolute:=False, ColumnAbsolute:=False)
ws2.Range(NextRow & ":J" & iRow).PasteSpecial


ws.Activate
ws.Range("B2:J100").ClearContents
    If iRow > 1000 Then
        ws2.Activate
        ws2.Range("B2:J1001").ClearContents
    End If

ActiveWorkbook.Save
Application.DisplayAlerts = True
ActiveWorkbook.Close

So the creation of the second sheet "archived" and that code I believe.

Yes that's correct

Alright so it all works - you were exactly right!! I took out the two lines:

ActiveWorkbook.Save

ActiveWorkbook.Close

And put them into the outlook vba before the xlWB close and I was off and running! I can't thank you enough for your help and second set of eyes on this. Now that it is all working and I have a little more time still and have fulfilled my self Proof of Concept I will incorporate the excel code into outlook and just run it all from there.

Thanks again!

Ah good suggestion - I will edit it with that in mind and see if it works. It definitely makes sense.

And yes, I believe you're right as well with doing it all from outlook and I may consolidate at the end here and try. I'm just running against a tight deadline and was trying to get it working before making it as efficient as possible.

I really appreciate your help and will let you know once I try this!