Question

从HTML文件中读取表并将其写入Excel，我得到了。

运行时错误'-2147467259（80004005）'：

自动化错误
  未指定的错误

AutomationError

此代码已从Internet复制并更新。它工作了好几次，但今天停止了工作。

同一个VBA项目中的另一个宏正在运行。

工具＆gt;引用已选择Microsoft ActiveX Data Objects 2.8库。

我看过类似的帖子，但无法解决我的问题。

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

代码中的错误位置：

Answer 1

尝试将代码放入“此工作簿”中并运行：

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

创建Internet Explorer对象生成运行时错误'-2147467259（80004005）'自动化错误未指定错误

1 个答案: