Can you please explain why this code getting error while running

[Kishore1982]

Sub ExtractTableFromEmailToExcel()
    On Error GoTo ErrorHandler ' Enable error handling

    Dim OutlookApp As Object
    Dim OutlookNamespace As Object
    Dim Inbox As Object
    Dim Subfolder As Object
    Dim Item As Object
    Dim HTMLDoc As Object
    Dim Table As Object
    Dim Row As Object
    Dim Cell As Object
    Dim ws As Worksheet
    Dim i As Integer
    Dim j As Integer

    ' Define Outlook constants
    Const olFolderInbox As Integer = 6
    Const olMail As Integer = 43

    ' Initialize Outlook objects
    Set OutlookApp = CreateObject("Outlook.Application")
    Set OutlookNamespace = OutlookApp.GetNamespace("MAPI")
    Set Inbox = OutlookNamespace.GetDefaultFolder(olFolderInbox)

    ' Replace "YourSubfolderName" with the name of your specific subfolder
    On Error Resume Next
    Set Subfolder = Inbox.Folders("YourSubfolderName")
    On Error GoTo ErrorHandler

    If Subfolder Is Nothing Then
        MsgBox "Subfolder 'YourSubfolderName' not found.", vbCritical
        Exit Sub
    End If

    ' Initialize Excel sheet
    On Error Resume Next
    Set ws = ThisWorkbook.Sheets("Sheet1")
    On Error GoTo ErrorHandler

    If ws Is Nothing Then
        MsgBox "Sheet1 not found in the workbook.", vbCritical
        Exit Sub
    End If

    ws.Cells.Clear ' Clear existing content
    i = 1

    ' Loop through each item in the subfolder
    For Each Item In Subfolder.Items
        Debug.Print "Processing Item: " & Item.Subject ' Output current email subject

        If TypeOf Item Is Object And Item.Class = olMail Then
            ' Check if the email subject contains any of the specified strings
            If Not IsNull(Item.Subject) And _
               (InStr(1, Item.Subject, "CB_Production Summary_", vbTextCompare) > 0 Or _
                InStr(1, Item.Subject, "CB Production", vbTextCompare) > 0 Or _
                InStr(1, Item.Subject, "CB _Production_", vbTextCompare) > 0) Then
               
                Debug.Print "Email matches condition: " & Item.Subject ' Output if email matches

                ' Initialize HTML document
                Set HTMLDoc = CreateObject("HTMLFile")
                HTMLDoc.body.innerHTML = Item.HTMLBody

                ' Loop through tables in the email body
                For Each Table In HTMLDoc.getElementsByTagName("table")
                    Debug.Print "Processing Table" ' Output when starting to process a table

                    ' Loop through rows in the table
                    For Each Row In Table.Rows
                        Debug.Print "Processing Row " & Row.RowIndex ' Output when starting to process a row

                        ' Loop through cells in the row
                        j = 1
                        For Each Cell In Row.Cells
                            ws.Cells(i, j).Value = Cell.innerText
                            Debug.Print "Cell " & j & ": " & Cell.innerText ' Output cell content
                            j = j + 1
                        Next Cell ' Closing Cell loop

                        i = i + 1
                    Next Row ' Closing Row loop

                    Exit For ' Exit after the first table is processed
                Next Table ' Closing Table loop
            End If
        End If
    Next Item ' Closing Item loop

    MsgBox "Table extraction complete!"
    Exit Sub

ErrorHandler:
    MsgBox "An error occurred: " & Err.Description, vbCritical
End Sub

Can you please explain why this code getting error while running

 

[ranman256]

can you mark where the error is?

 

[Joe4]

Whenever you get an error, it is helpful if you can tell us the exact error number and message that is being returned.

Also, many times that error message box will give you a "Debug" option. If you click that, it will highlight the line of code causing the error.
So if you could click that button, and tell us what line of code that highlights, that would be helpful.