在Excel VBA中,检查网页是否已满载的方法是什么?

Inn*_*ube 5 excel internet-explorer vba excel-vba web-scraping

要暂停代码直到网页完全加载,我几乎一直都在使用下面的方法取得了巨大的成功.

Do While objIE.Busy = True Or objIE.readyState <> 4: DoEvents: Loop
Run Code Online (Sandbox Code Playgroud)

但偶尔,我会在方法确定页面已完全加载后看到文本内容加载,因此不会提取内容.

但是,如果我通过F8单步执行代码,则每次都会提取内容.这是我可以反复按F8键的速度.

那么如何在代码继续提取数据之前检查以确保页面及其所有内容是否已完全加载?

在这两种情况下,IE都是无形的运行.但是,我已经尝试使用IE浏览器,并且在我正在使用的页面上的这个特定位置实际上有内容.

这是在Excel 2016中使用VBA脚本完成的.具体内容请求如下:

 'get item name from page and write it to the first cell on the first empty row available
 Set itemName = objIE.document.querySelector(".the-item-name")
 Worksheets("Results").Range("A1048576").End(xlUp).Offset(1, 0).Value = itemName.innerText
Run Code Online (Sandbox Code Playgroud)

我已经阅读了Excel VBA:等待在Internet Explorer中执行JavaScript,因为我认为在加载文档后可能会添加值,以防止任何人抓取数据.但是,我似乎无法识别可能正在执行此操作的任何脚本.并不意味着它不存在.我还是看不到它.

具有此问题的页面的具体示例是URL

https://www.homedepot.ca/en/home/p.dry-cloth-refills-32---count.1000660019.html

最初product-total-pricediv元素包含破折号( - ),在加载价格之前,这就是请求将返回的内容:- / each而不是$11.29 / each.

我有一个解决方法,但它不像我希望的那样高效或简洁.我测试返回的字符串是否存在破折号.如果它在那里,循环并再次检查它,否则捕获它并将其插入工作表.

setPriceUM:
    Set hdPriceUM = objIE.document.querySelector(".product-total-price").innerTe????xt
    hdPriceUMString = hdPriceUM.innerText
    stringTest = InStr(hdPriceUMString, "-")
    If stringTest = True Then
        GoTo setPriceUM
    Else
        Debug.Print hdPriceUMString
    End If
Run Code Online (Sandbox Code Playgroud)

感谢您抽出宝贵时间阅读本文并加以考虑.

ome*_*pes 3

网页的功能差异很大,因此没有适合所有网页的解决方案。

关于您的示例,您的解决方法是一个可行的解决方案,代码可能如下:

Sub TestIE()

    Dim q

    With CreateObject("InternetExplorer.Application")
        .Visible = True
        .Navigate "https://www.homedepot.ca/en/home/p.dry-cloth-refills-32---count.1000660019.html"
        ' Wait IE
        Do While .readyState < 4 Or .Busy
            DoEvents
        Loop
        ' Wait document
        Do While .document.readyState <> "complete"
            DoEvents
        Loop
        ' Wait element
        Do
            q = .document.querySelector(".product-total-price").innerText
            If Left(q, 1) <> "-" Then Exit Do
            DoEvents
        Loop
        .Quit
    End With
    Debug.Print q

End Sub
Run Code Online (Sandbox Code Playgroud)

无论如何,您需要使用浏览器开发人员工具(F12)查看网页加载过程、XHR 和 DOM 修改。这样一来,您可能会发现众多 XHR 之一以 JSON 格式返回价格。它会在页面加载时出现价格之前登录到浏览器开发人员工具的网络选项卡上。该 XHR 是由加载的 JS 之一生成的,特别是在页面加载事件之后。试试这个 URL(我刚刚从网络选项卡复制它):

https://www.homedepot.ca/homedepotcacommercewebservices/v2/homedepotca/products/1000660019/localized/9999?catalogVersion=Online&lang=en

因此,您可以复制该 XHR 并通过拆分来提取价格:

Sub TestXHR()

    Dim q

    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", "https://www.homedepot.ca/homedepotcacommercewebservices/v2/homedepotca/products/1000660019/localized/9999?catalogVersion=Online&lang=en", False
        .Send
        q = .ResponseText
    End With
    q = Replace(q, " : ", ":")
    q = Split(q, """displayPrice""", 2)(1)
    q = Split(q, """formattedValue"":""", 2)(1)
    q = Split(q, """", 2)(0)
    Debug.Print q

End Sub
Run Code Online (Sandbox Code Playgroud)

但同样,没有常见的情况。

您还可以使用 JSON 解析器,看一些示例