VBA 代码 - 卡在第 4 个循环

Question

我有一个应该打开网站的代码，select 一个位置，将 HTML table 复制到 Excel sheet 和在另一个位置重复。但是，当我尝试运行 'For' 循环时，我在第 4 次迭代时出错。消息说 "Object variable or With block variable not set"。调试工具指向第 44 行

Sub ParseTable()
    Dim IE As InternetExplorer
    Dim htmldoc As MSHTML.HTMLDocument 'Document object
    Dim eleColtr As MSHTML.IHTMLElementCollection 'Element collection for tr tags
    Dim eleColtd As MSHTML.IHTMLElementCollection 'Element collection for td tags
    Dim eleRow As MSHTML.IHTMLElement 'Row elements
    Dim eleCol As MSHTML.IHTMLElement 'Column elements
    Dim ieURL As String 'URL
    Dim x As Integer
    Dim y As String

y = "A1"

For x = 1 To 4
    If x <> 2 Then 'Skip iteration 2
        Set IE = New InternetExplorer
        IE.Visible = True
        Application.ScreenUpdating = False

        ieURL = "***"
        IE.navigate ieURL
 'Wait
        Do While IE.Busy Or IE.readyState <> 4
            DoEvents
        Loop

        Set htmldoc = IE.document 'Document webpage

        Do While IE.Busy Or IE.readyState <> 4
            DoEvents
        Loop

    IE.document.getElementById("ddlLevel1").selectedIndex = x
    IE.document.getElementById("ddlLevel1").FireEvent ("onchange")
    Do While IE.Busy Or IE.readyState <> 4
        DoEvents
    Loop
    Set eleColtr = IE.document.getElementsByTagName("tr") 'Find all tr tags

    'This section populates Excel
            i = 0 'start with first value in tr collection
            For Each eleRow In eleColtr 'for each element in the tr collection
                Set eleColtd = IE.document.getElementsByTagName("tr")(i).getElementsByTagName("td") 'get all the td elements in that specific tr
                j = 0 'start with the first value in the td collection
                For Each eleCol In eleColtd 'for each element in the td collection
                    Sheets("Sheet1").Range(y).Offset(i, j).Value = eleCol.innerText 'paste the inner text of the td element, and offset at the same time
                    j = j + 1 'move to next element in td collection
                Next eleCol 'rinse and repeat
                i = i + 1 'move to next element in td collection
            Next eleRow 'rinse and repeat
            Sheets("Sheet1").Range(y).Offset(i, 0).Select
            y = "A" & ActiveCell.Row
            IE.Quit
      End If
 Next x
 Application.ScreenUpdating = True
 End Sub

不确定可能的原因是什么。我确实从 Excel sheet 上的前 4 个位置（减去位置 2）得到了 tables。请原谅我冗长、低效的代码（我自己不是程序员）。我使用的网页需要登录并且有机密数据，但我会尽量提供输入。在此先感谢您的帮助！

Answer 1

我在很多示例中看到这种情况，这些示例在进一步处理之前尝试等待 IE.Busy。问题是文档模型尚未完全形成，因此您在尝试访问对象模型中的元素时遇到错误。

最安全的方法是实际循环直到对象存在 - 即。如果您确实知道它会出现在每个文档中。如果您想安全起见，可以在停止并显示错误消息之前添加检查次数限制。

将此添加到您的模块顶部

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

然后替换这一行（如果是问题行）

Set eleColtr = IE.document.getElementsByTagName("tr")

有了这个轻微的延迟和 DoEvents - 然后一个循环来检查你的 tr 元素

DoEvents
Sleep 1000 ' delay once second
Do 
   DoEvents
   Sleep 500 ' delay half a second
Loop Until not IsNull(IE.document.getElementsByTagName("tr"))

如果它进入无限循环，找不到你的 tr 元素，你可以在尝试次数上设置一个计数器

我还会在每个循环开始时添加一个延迟

For Each eleRow In eleColtr之后添加 Sleep 500

VBA 代码 - 卡在第 4 个循环

VBA code - Stuck at the 4th loop

excel

vba

excel-2010

internet-explorer-11