首页 > 解决方案 > Excel VBA doc.querySelectorAll("p") 不会捕获/选择所有 p 元素

问题描述

我正在尝试修复一个 Excel 计算器,该计算器从该网站提取 TNT 的最新国际附加费率:https ://www.tnt.com/express/en_nz/site/shipping-services/fuel-surcharges-apac.html 如您所见,15.75% 是最新的附加费率。

我上传的截图是特定的 p 标签,我想在其中提取“15.75%”内的内容。网页截图

我有以下 VBA 代码来测试我得到了正确的元素:

Sub GetFuelSurchargeWeb()

    Dim xhr As Object
    Dim doc As MSHTML.HTMLDocument
    Dim table As Object
    Dim tableCell As HTMLHtmlElement
    Dim valCharge As String, url As String, inrText As String, searchTag1 As String, searchTag2 As String, valFrom As String
    Dim i As Integer, tag1Indx As Integer, tag2Indx As Integer, tag3Indx As Integer
    Dim searchTag3 As String
    Dim ObjP As Object

    url = "https://www.tnt.com/express/en_nz/site/shipping-services/fuel-surcharges-apac.html"
    searchTag1 = "FROM"
    searchTag2 = ":"
    searchTag3 = ":"

    On Error GoTo ErrHndlr
    Application.ScreenUpdating = False

    Set xhr = CreateObject("MSXML2.XMLHTTP")

    With xhr
        .Open "GET", url, False
        .send
        If .readyState = 4 And .status = 200 Then
            Set doc = New MSHTML.HTMLDocument
            doc.body.innerHTML = .responseText
        Else
            MsgBox "Error" & vbNewLine & "Ready state: " & .readyState & _
            vbNewLine & "HTTP request status: " & .status
        End If
    End With

    Set ObjP = doc.querySelectorAll("p")
    Debug.Print (ObjP.Length)
    For Each table In ObjP
        Debug.Print (table.innerHTML)
    Next table

当我打印 p 标签元素的 innerHTML 时,它似乎抓住了第一段之类的内容,“周”“每加仑美元”“所有服务”,但随后跳过了“2019 年 9 月 23 日 - 2019 年 9 月 29 日”之类的内容“1.833”“15.75%”,尽管它们都包含在 p 标签中。

我才刚刚开始使用 VBA,对如何获得这个值感到困惑。如果有人可以帮助我提供解决方案或替代方案以获得我想要的价值,我将不胜感激。理想情况下,我希望包含当前周的元素也是“2019 年 9 月 23 日 - 2019 年 9 月 29 日”,但我现在只关心附加费率。

标签: excelvbaweb-scrapingxmlhttprequest

解决方案


该内容是从您未捕获的另一个端点动态检索的。您可以在网络选项卡中找到它。它返回 json,因此理想情况下,您可以使用 jsonconverter.bas 之类的 json 解析器来处理响应并提取感兴趣的值。有问题的端点是https://www.tnt.com/express/getDynamicData.apac.json

从 json 中提取最新数据点的示例

Option Explicit

Public Sub GetData()
    Dim json As Object

    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", "https://www.tnt.com/express/getDynamicData.apac.json", False
        .setRequestHeader "User-Agent", "Mozilla/5.0"
        .send
        Set json = JsonConverter.ParseJson(.responsetext)("list")(1)
        Debug.Print json("week"), json("weeklyPrice"), json("surcharge")
    End With
End Sub

json 库:

我使用 jsonconverter.bas。从这里下载原始代码并添加到名为 jsonConverter 的标准模块中。然后您需要转到 VBE > 工具 > 参考 > 添加对 Microsoft Scripting Runtime 的引用。Attribute从复制的代码中删除第一行。

在此处探索 json:https ://jsoneditoronline.org/?id=7266ab97d0ac463cb934083fc549038b


推荐阅读