在Excel VBA中，检查网页是否完全加载的方法是什么？

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

Do While objIE.Busy = True Or objIE.readyState <> 4: DoEvents: Loop 

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

但是，如果我通过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 

我已经通过Excel VBA阅读：在Internet Explorer中等待JavaScript执行，因为我认为可能在文档加载之后添加了值，以防止任何人抓取数据。 但是，我似乎无法确定任何可能会这样做的脚本。 这并不意味着它不在那里。 我现在还看不到它。

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

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

最初的product-total-price div元素包含破折号（ – ），在价格被加载之前，所以这就是请求将返回： - / each而不是$11.29 / each 。

我有一个解决方法，但它并不像我希望的那样高效或简洁。 我testing返回的string的存在的string。 如果在那里，循环并再次检查，否则捕获它并将其插入到工作表中。

 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 

感谢您抽出宝贵时间阅读并考虑这一点。

Answer 1

网页的function是非常不同的，所以没有适合所有的解决scheme。

关于你的例子，你的解决方法是一个可行的解决scheme，代码可能是这样的：

 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 

无论如何，您需要使用浏览器开发工具（F12）来查看网页加载过程，XHR和DOM修改。 这样，您可能会发现众多XHR中的一个以JSON格式返回价格。 它在浏览器开发人员工具的networking选项卡上login，正好在页面加载时出现价格之前。 XHR是由加载的JS之一，特别是页面加载事件后。 试试这个URL（我刚刚从networking标签复制）：

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 

但是，再一次没有常见的情况。