Question

我正在尝试使用Excel VBA从网页上抓取产品价格。使用VBA Internet Explorer导航请求时，以下代码有效。但是，我想使用XML HTTP请求来加快抓取过程。

在IE请求代码中，我告诉应用程序等待3秒，以使页面完全加载并能够抓取产品价格。如果不包括此行，将找不到价格。

我尝试使用XML HTTP请求（请参见第二个代码）更改此设置，但未成功。找不到价格输出。似乎代码尝试在完全加载页面之前抓取该页面。

如何调整XML HTTP请求代码，以便它可以找到产品价格（并且仅在页面（和脚本）完全加载时才开始搜索/抓取？）

以下IE请求代码正在运行：（立即调试。打印产品价格）

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

感谢您的帮助！

Answer 1

REST API HTTP请求：

您所注意到的，您当前的方法不允许页面完全加载。您可以使用URLEncode公式化REST API XMLHTTPrequest，以将编码的URL字符串传递给API。服务器发回一个JSON响应，其中包含您需要的值以及许多其他信息。

我演示了两种从返回的JSON字符串中提取价格信息的方法：①使用Split函数通过生成子字符串直到剩下所需的字符串来提取价格； ②使用JSONParser浏览JSON结构并返回所需的值。

代码：

以下使用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解析器（例如JSONConverter.bas）将整个JSON响应读入JSON对象。然后解析该对象的价格。我发现使用Split函数来提取如下所示的所需信息更为简单：

Split返回基于零的一维数组，该数组包含基于在指定定界符上分割输入字符串的指定数目的子字符串。

在该行中，

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之后，您可以通过Microsoft Scripting Runtime添加对VBE > Tools > References的引用。的 Set json代码语句上方的代码表示价格的路径，如下面的JSON结构所示。我折叠了一些细节以使路径更清晰。您可以将以上两行插入到原始代码中，以代替Split行。

上图中的[]表示一个collection对象，该对象需要通过索引（例如， JsonConverter.ParseJson(sResponse)("_embedded")("lanes")(5)。 {}表示一个dictionary对象，可以通过键，例如JsonConverter.ParseJson(sResponse)("_embedded")("lanes")(5)("_embedded")。我这行的语法

Set json = JsonConverter.ParseJson(sResponse)("_embedded")("lanes")(5)("_embedded")("items")(1)("_embedded")("product")("priceLabel")

展示了导航这两种对象类型的不同语法。

使用Excel VBA用XML HTTP请求来抓取网站：等待页面完全加载

1 个答案:

REST API HTTP请求：

解析JSON响应：