Creating Internet Explorer object generates Run-time error '-2147467259 (80004005)' Automation Error Unspecified Error

Question

Reading tables from an HTML file and writing it to Excel, I get.

Run-time error '-2147467259 (80004005)':

Automation Error
Unspecified Error

AutomationError

This code was copied from the Internet and updated. It worked several times but today stopped working.

Another macro in same VBA project is working.

Tools >References have Microsoft ActiveX Data Objects 2.8 Library selected.

I have seen similar posts but could not get my issue resolved.

Option Explicit

Sub TableExample()
    Dim IE As Object
    Dim doc As Object
    Dim strURL As String

    '.html file path to read tables from it
    strURL = "file:///C:/Users/javaperson/Documents/Extracter/Email%20Attachments/SO23457842.html"

    If IE Is Nothing Then Set IE = CreateObject("InternetExplorer.Application")

    With IE
        .navigate strURL

        Do Until .ReadyState = 4: DoEvents: Loop
            Do While .Busy: DoEvents: Loop
                Set doc = IE.Document
                GetAllTables doc
                .Quit
    End With
End Sub

Sub GetAllTables(doc As Object)

    ' get all the tables from a webpage document, doc, and put them in a new worksheet
    Dim ws As Worksheet
    Dim rng As Range
    Dim tbl As Object
    Dim rw As Object
    Dim cl As Object
    Dim tabno As Long
    Dim nextrow As Long
    Dim I As Long
    Dim I2 As Long
    Dim rowFound As Range

    Dim ContainWord As Variant
    ContainWord = Array("Form:", "ETA Date:")

    Set ws = Worksheets.Add

    For Each tbl In doc.getElementsByTagName("TABLE")
        tabno = tabno + 1
        nextrow = nextrow + 1
        Set rng = ws.Range("B" & nextrow)
        'rng.Offset(, -1) = "Table " & tabno

        For Each rw In tbl.Rows
            If tabno = "5" Then      'Just need to process Table No 5.
                For Each cl In rw.Cells
                    rng.Value = cl.outerText
                    'Remove unwanted rows like "Form:", "ETA Date:" START
                    For I2 = LBound(ContainWord) To UBound(ContainWord)
                        Set rowFound = rng.Find(ContainWord(I2))
                        If Not rowFound Is Nothing Then
                             MsgBox rng.Value
                             rng.Clear
                        End If
                    Next I2
                    'Remove unwanted rows like "Form:", "ETA Date:" END

                    Set rng = rng.Offset(, 1)
                    I = I + 1
                Next cl
                nextrow = nextrow + 1
                Set rng = rng.Offset(1, -I)
                I = 0
            End If
        Next rw
    Next tbl
    ws.Cells.ClearFormats
End Sub

Error location in code:

DaBeau96 DaBeau96 · Accepted Answer · 2017-09-14T22:43:47

Try putting the code in the "This Workbook" and run this:

Option Explicit

Private Sub Workbook_Open()
TableExample
End Sub

Sub TableExample()
Dim IE As Object
Dim doc As Object
Dim strURL As String

'.html file path to read tables from it
strURL = "file:///C:/Users/javaperson/Documents/Extracter/Email%20Attachments/SO23457842.html"


If IE Is Nothing Then Set IE = CreateObject("InternetExplorer.Application")

With IE
    .navigate strURL

    Do Until .ReadyState = 4: DoEvents: Loop
        Do While .Busy: DoEvents: Loop
            Set doc = IE.Document
            GetAllTables doc
            .Quit
End With
End Sub

Sub GetAllTables(doc As Object)

' get all the tables from a webpage document, doc, and put them in a new worksheet
        Dim ws As Worksheet
        Dim rng As Range
        Dim tbl As Object
        Dim rw As Object
        Dim cl As Object
        Dim tabno As Long
        Dim nextrow As Long
        Dim I As Long
        Dim I2 As Long
        Dim rowFound As Range


        Dim ContainWord As Variant
        ContainWord = Array("Form:", "ETA Date:")

        Set ws = Worksheets.Add

        For Each tbl In doc.getElementsByTagName("TABLE")
            tabno = tabno + 1
            nextrow = nextrow + 1
            Set rng = ws.Range("B" & nextrow)
            'rng.Offset(, -1) = "Table " & tabno

            For Each rw In tbl.Rows
            If tabno = "5" Then      'Just need to process Table No 5.
                For Each cl In rw.Cells
                    rng.Value = cl.outerText
                    'Remove unwanted rows like "Form:", "ETA Date:" START
                    For I2 = LBound(ContainWord) To UBound(ContainWord)
                    Set rowFound = rng.Find(ContainWord(I2))
                    If Not rowFound Is Nothing Then
                         MsgBox rng.Value
                         rng.Clear
                    End If
                    Next I2
                    'Remove unwanted rows like "Form:", "ETA Date:" END

                    Set rng = rng.Offset(, 1)
                    I = I + 1
                Next cl
                nextrow = nextrow + 1
                Set rng = rng.Offset(1, -I)
                I = 0
             End If
             Next rw
        Next tbl
        ws.Cells.ClearFormats
End Sub

Creating Internet Explorer object generates Run-time error '-2147467259 (80004005)' Automation Error Unspecified Error

1 Answers