使用 XML 使用 Excel VBA HTTP 请求抓取网站：等待页面完全加载
Scrape website with XML HTTP request with Excel VBA: wait for the page to fully load
我正在尝试使用 Excel VBA 从网页中抓取产品价格。以下代码在使用 VBA Internet Explorer 导航请求时有效。但是我想使用 XML HTTP 请求来加快抓取过程。
在 IE 请求代码中，我告诉应用程序等待 3 秒以使页面完全加载并能够抓取产品价格。如果不包含此行，它将找不到价格。
我试图通过 XML HTTP 请求（参见第二个代码）来更改它，但没有成功。没有找到价格输出。似乎代码试图在页面完全加载之前抓取该页面。
如何调整 XML HTTP 请求代码，以便它可以找到产品价格（并且仅在页面（和脚本）完全加载时才启动 searching/scraping？
以下 IE 请求代码有效：
(立即debug.prints一个产品的价格)
Sub Get_Product_Price_AH_IE()
Dim IE As New SHDocVw.InternetExplorer
Dim HTMLDoc As MSHTML.HTMLDocument
Dim AHArticles As MSHTML.IHTMLElementCollection
Dim AHArticle As MSHTML.IHTMLElement
Dim AHEuros As MSHTML.IHTMLElementCollection
Dim AHCents As MSHTML.IHTMLElementCollection
Dim AHPriceEuro As Double
Dim AHPriceCent As Double
Dim AHPrice As Double
IE.Visible = False
IE.navigate "https://www.ah.nl/producten/product/wi3640/lu-bastogne-biscuits-original"
Do While IE.readyState <> READYSTATE_COMPLETE
Loop
Set HTMLDoc = IE.document
'wait for the page to fully load to be able to get price data
Application.Wait Now + #12:00:03 AM#
Set AHArticles = HTMLDoc.getElementsByTagName("article")
For Each AHArticle In AHArticles
If AHArticle.getAttribute("data-sku") = "wi3640" Then
Set AHEuros = AHArticle.getElementsByClassName("price__integer")
Set AHCents = AHArticle.getElementsByClassName("price__fractional")
AHPriceEuro = AHEuros.Item(0).innerText
AHPriceCent = AHCents.Item(0).innerText
AHPrice = AHPriceEuro + (AHPriceCent / 100)
Debug.Print AHPrice
Exit For
End If
Next AHArticle
IE.Quit
End Sub
以下 XML HTTP 请求未提供所需的输出（即时调试屏幕中未打印价格）：
Sub Get_Product_Price_AH_XML()
Dim XMLReq As New MSXML2.XMLHTTP60
Dim HTMLDoc As New MSHTML.HTMLDocument
Dim AHArticles As MSHTML.IHTMLElementCollection
Dim AHArticle As MSHTML.IHTMLElement
Dim AHEuros As MSHTML.IHTMLElementCollection
Dim AHCents As MSHTML.IHTMLElementCollection
Dim AHPriceEuro As Double
Dim AHPriceCent As Double
Dim AHPrice As Double
XMLReq.Open "GET", "https://www.ah.nl/producten/product/wi3640/lu-bastogne-biscuits-original", False
XMLReq.send
If XMLReq.Status <> 200 Then
MsgBox "Problem" & vbNewLine & XMLReq.Status & " - " & XMLReq.statusText
Exit Sub
End If
HTMLDoc.body.innerHTML = XMLReq.responseText
Application.Wait Now + #12:00:03 AM#
Set AHArticles = HTMLDoc.getElementsByTagName("article")
For Each AHArticle In AHArticles
If AHArticle.getAttribute("data-sku") = "wi3640" Then
Set AHEuros = AHArticle.getElementsByClassName("price__integer")
Set AHCents = AHArticle.getElementsByClassName("price__fractional")
AHPriceEuro = AHEuros.Item(0).innerText
AHPriceCent = AHCents.Item(0).innerText
AHPrice = AHPriceEuro + (AHPriceCent / 100)
Debug.Print AHPrice
Exit For
End If
Next AHArticle
End Sub
REST API HTTP 请求：
如您所述，您当前的方法不允许页面完全加载。您可以制定 REST API XMLHTTPrequest，使用 URLEncode 将编码的 URL 字符串传递给 API。服务器发回一个 JSON 响应，其中包含您想要的值以及许多其他信息。
我演示了两种从 returned JSON 字符串中提取价格信息的方法： ① 使用 Split 函数通过生成子字符串提取价格，直到所需的字符串是剩下; ② 使用 JSONParser 导航 JSON 结构和 return 所需的值。
代码：
下面使用Split提取值
Option Explicit
Public Sub GetPrice()
Const BASE_URL As String = "https://www.ah.nl/service/rest/delegate?url="
Dim URL As String, sResponse As String, price As String
URL = BASE_URL & Application.WorksheetFunction.EncodeURL("/producten/product/wi3640/lu-bastogne-biscuits-original")
With CreateObject("MSXML2.XMLHTTP")
.Open "GET", URL, False
.send
sResponse = StrConv(.responseBody, vbUnicode)
End With
price = Split(Split(sResponse, """now"":")(1), "}")(0)
Debug.Print price
End Sub
正在解析 JSON 响应：
使用Split:
您可以使用 JSON 解析器将整个 JSON 响应读入 JSON 对象，例如 JSONConverter.bas. Then parse that object for price. I found it simpler to use Split 函数以提取所需信息，如下所示：
拆分return一个从零开始的一维数组，其中包含基于指定分隔符拆分输入字符串的指定数量的子字符串。
在行中，
price = Split(Split(sResponse, """now"":")(1), "}")(0)
我有两个嵌套的 Split 语句。这些连续拆分响应 JSON 字符串以提取价格 1.55.
第一次拆分使用 "now": 作为分隔符，结果数组如下：
你能看到的目标价在第1位的字符串中
因此，该字符串是通过以下方式提取的：
Split(sResponse, """now"":")(1)
然后我们只需要获取价格，因此再次使用 Split 通过使用分隔符 "}":
来获取 1.55
Split(Split(sResponse, """now"":")(1), "}")
这导致以下数组（缩短为相当长）：
我们想要的价格现在位于新数组中的位置 0，这就是我们可以使用以下内容提取响应的原因。
price = Split(Split(sResponse, """now"":")(1), "}")(0)
使用 JSON 解析器：
如果您想遍历 json 结构，您可以使用以下内容：
Dim json As Object
Set json = JsonConverter.ParseJson(sResponse)("_embedded")("lanes")(5)("_embedded")("items")(1)("_embedded")("product")("priceLabel")
Debug.Print json("now")
下载并添加 JSONConverter.bas 后，您可以通过 VBE > Tools > References 添加对 Microsoft Scripting Runtime 的引用。这
上面的 Set json 代码语句代表价格的路径，如下面的 JSON 结构所示。我折叠了一些细节以使路径更清晰。您可以将上面几行插入到原始代码中，代替 Split 行。
在上图中，[] 表示一个 collection object which needs to be accessed via index, e.g. JsonConverter.ParseJson(sResponse)("_embedded")("lanes")(5). The {} denotes a dictionary 对象，可以通过键访问，例如JsonConverter.ParseJson(sResponse)("_embedded")("lanes")(5)("_embedded")。我的行中的语法，
Set json = JsonConverter.ParseJson(sResponse)("_embedded")("lanes")(5)("_embedded")("items")(1)("_embedded")("product")("priceLabel")
演示导航这两种对象类型的不同语法。
我正在尝试使用 Excel VBA 从网页中抓取产品价格。以下代码在使用 VBA Internet Explorer 导航请求时有效。但是我想使用 XML HTTP 请求来加快抓取过程。
在 IE 请求代码中，我告诉应用程序等待 3 秒以使页面完全加载并能够抓取产品价格。如果不包含此行，它将找不到价格。
我试图通过 XML HTTP 请求（参见第二个代码）来更改它，但没有成功。没有找到价格输出。似乎代码试图在页面完全加载之前抓取该页面。
如何调整 XML HTTP 请求代码，以便它可以找到产品价格（并且仅在页面（和脚本）完全加载时才启动 searching/scraping？
以下 IE 请求代码有效： (立即debug.prints一个产品的价格)
Sub Get_Product_Price_AH_IE()
Dim IE As New SHDocVw.InternetExplorer
Dim HTMLDoc As MSHTML.HTMLDocument
Dim AHArticles As MSHTML.IHTMLElementCollection
Dim AHArticle As MSHTML.IHTMLElement
Dim AHEuros As MSHTML.IHTMLElementCollection
Dim AHCents As MSHTML.IHTMLElementCollection
Dim AHPriceEuro As Double
Dim AHPriceCent As Double
Dim AHPrice As Double
IE.Visible = False
IE.navigate "https://www.ah.nl/producten/product/wi3640/lu-bastogne-biscuits-original"
Do While IE.readyState <> READYSTATE_COMPLETE
Loop
Set HTMLDoc = IE.document
'wait for the page to fully load to be able to get price data
Application.Wait Now + #12:00:03 AM#
Set AHArticles = HTMLDoc.getElementsByTagName("article")
For Each AHArticle In AHArticles
If AHArticle.getAttribute("data-sku") = "wi3640" Then
Set AHEuros = AHArticle.getElementsByClassName("price__integer")
Set AHCents = AHArticle.getElementsByClassName("price__fractional")
AHPriceEuro = AHEuros.Item(0).innerText
AHPriceCent = AHCents.Item(0).innerText
AHPrice = AHPriceEuro + (AHPriceCent / 100)
Debug.Print AHPrice
Exit For
End If
Next AHArticle
IE.Quit
End Sub
以下 XML HTTP 请求未提供所需的输出（即时调试屏幕中未打印价格）：
Sub Get_Product_Price_AH_XML()
Dim XMLReq As New MSXML2.XMLHTTP60
Dim HTMLDoc As New MSHTML.HTMLDocument
Dim AHArticles As MSHTML.IHTMLElementCollection
Dim AHArticle As MSHTML.IHTMLElement
Dim AHEuros As MSHTML.IHTMLElementCollection
Dim AHCents As MSHTML.IHTMLElementCollection
Dim AHPriceEuro As Double
Dim AHPriceCent As Double
Dim AHPrice As Double
XMLReq.Open "GET", "https://www.ah.nl/producten/product/wi3640/lu-bastogne-biscuits-original", False
XMLReq.send
If XMLReq.Status <> 200 Then
MsgBox "Problem" & vbNewLine & XMLReq.Status & " - " & XMLReq.statusText
Exit Sub
End If
HTMLDoc.body.innerHTML = XMLReq.responseText
Application.Wait Now + #12:00:03 AM#
Set AHArticles = HTMLDoc.getElementsByTagName("article")
For Each AHArticle In AHArticles
If AHArticle.getAttribute("data-sku") = "wi3640" Then
Set AHEuros = AHArticle.getElementsByClassName("price__integer")
Set AHCents = AHArticle.getElementsByClassName("price__fractional")
AHPriceEuro = AHEuros.Item(0).innerText
AHPriceCent = AHCents.Item(0).innerText
AHPrice = AHPriceEuro + (AHPriceCent / 100)
Debug.Print AHPrice
Exit For
End If
Next AHArticle
End Sub
REST API HTTP 请求：
如您所述，您当前的方法不允许页面完全加载。您可以制定 REST API XMLHTTPrequest，使用 URLEncode 将编码的 URL 字符串传递给 API。服务器发回一个 JSON 响应，其中包含您想要的值以及许多其他信息。
我演示了两种从 returned JSON 字符串中提取价格信息的方法： ① 使用 Split 函数通过生成子字符串提取价格，直到所需的字符串是剩下; ② 使用 JSONParser 导航 JSON 结构和 return 所需的值。
代码：
下面使用Split提取值
Option Explicit
Public Sub GetPrice()
Const BASE_URL As String = "https://www.ah.nl/service/rest/delegate?url="
Dim URL As String, sResponse As String, price As String
URL = BASE_URL & Application.WorksheetFunction.EncodeURL("/producten/product/wi3640/lu-bastogne-biscuits-original")
With CreateObject("MSXML2.XMLHTTP")
.Open "GET", URL, False
.send
sResponse = StrConv(.responseBody, vbUnicode)
End With
price = Split(Split(sResponse, """now"":")(1), "}")(0)
Debug.Print price
End Sub
正在解析 JSON 响应：
使用Split:
您可以使用 JSON 解析器将整个 JSON 响应读入 JSON 对象，例如 JSONConverter.bas. Then parse that object for price. I found it simpler to use Split 函数以提取所需信息，如下所示：
拆分return一个从零开始的一维数组，其中包含基于指定分隔符拆分输入字符串的指定数量的子字符串。
在行中，
price = Split(Split(sResponse, """now"":")(1), "}")(0)
我有两个嵌套的 Split 语句。这些连续拆分响应 JSON 字符串以提取价格 1.55.
第一次拆分使用 "now": 作为分隔符，结果数组如下：
你能看到的目标价在第1位的字符串中
因此，该字符串是通过以下方式提取的：
Split(sResponse, """now"":")(1)
然后我们只需要获取价格，因此再次使用 Split 通过使用分隔符 "}":
1.55
Split(Split(sResponse, """now"":")(1), "}")
这导致以下数组（缩短为相当长）：
我们想要的价格现在位于新数组中的位置 0，这就是我们可以使用以下内容提取响应的原因。
price = Split(Split(sResponse, """now"":")(1), "}")(0)
使用 JSON 解析器：
如果您想遍历 json 结构，您可以使用以下内容：
Dim json As Object
Set json = JsonConverter.ParseJson(sResponse)("_embedded")("lanes")(5)("_embedded")("items")(1)("_embedded")("product")("priceLabel")
Debug.Print json("now")
下载并添加 JSONConverter.bas 后，您可以通过 VBE > Tools > References 添加对 Microsoft Scripting Runtime 的引用。这
上面的 Set json 代码语句代表价格的路径，如下面的 JSON 结构所示。我折叠了一些细节以使路径更清晰。您可以将上面几行插入到原始代码中，代替 Split 行。
在上图中，[] 表示一个 collection object which needs to be accessed via index, e.g. JsonConverter.ParseJson(sResponse)("_embedded")("lanes")(5). The {} denotes a dictionary 对象，可以通过键访问，例如JsonConverter.ParseJson(sResponse)("_embedded")("lanes")(5)("_embedded")。我的行中的语法，
Set json = JsonConverter.ParseJson(sResponse)("_embedded")("lanes")(5)("_embedded")("items")(1)("_embedded")("product")("priceLabel")
演示导航这两种对象类型的不同语法。