VBA代码 - 陷入第4个循环

时间:2016-08-02 02:55:01

标签: excel vba excel-vba excel-2010 internet-explorer-11

我有一个代码应该打开一个网站,选择一个位置,将HTML表格复制到Excel表格并在另一个位置重复。但是,当我尝试运行'For'循环时,我在第4次迭代时遇到错误。消息说“对象变量或With块变量未设置”。调试工具指向第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表格的前4个位置(减去位置2)获取了表格。请原谅我漫长而低效的代码(我自己不是程序员)。我使用的网页需要登录并拥有机密数据,但我会尽量提供输入。在此先感谢您的帮助!

1 个答案:

答案 0 :(得分:0)

我发现很多例子都会在进一步处理之前等待IE.Busy。问题是文档模型还没有完全形成,所以在尝试访问对象模型中的元素时会出错。

最安全的方法是实际循环直到对象存在 - 即。如果你知道它会出现在每个文件中。如果您想要安全地玩游戏,可以在停止收到错误消息之前添加限制。

将其添加到模块顶部

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

然后替换此行(如果是问题行)

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

使用这个轻微的Delay和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