时间戳

首页 > 解决方案 > 如何使用查询选择器选择没有特定类名的元素？

html - 如何使用查询选择器选择没有特定类名的元素？

问题描述

我正在做 VBA 网络抓取以跟踪联邦快递发货的状态。

网址是
https://www.fedex.com/apps/fedextrack/index.html?tracknumbers=475762806100&cntry_code=in

此货件的当前状态为已送达。我想提取这个。

我知道如何选择具有类名的元素。

上述网站的 HTML 代码没有类名。

如何使用 queryselector 选择没有特定类名的元素？

我在我的 VBA 代码中使用了最快的方法，即 MSXML2.XMLHTTP。此方法的一个缺点是 getelementbyclassname 在此方法或任何其他使程序感知 getelementbyclassname 的方法中不起作用。

这就是我选择使用 queryselector 的原因。

我无法使用查询选择器选择正确的元素。

在此处输入图像描述

从 HTML 代码中，如何获取名为 -----“redesignStatusChevronTVC tank-results-item__data-label-large tank-text-center statusChevron_key_status”的类的内部文本？

<h3 class="redesignStatusChevronTVC tank-results-item__data-label-large tank-text-center statusChevron_key_status">Delivered</h3>

Sub GetInfo()
    Dim sResponse As String, i As Long, html As New HTMLDocument
    Dim prices As Object, info As Object
    Application.ScreenUpdating = False

    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", "https://www.fedex.com/apps/fedextrack/index.html?tracknumbers=475762806100&cntry_code=in", False
        .send
        sResponse = .responseText
    End With

    With html
        .body.innerHTML = sResponse
        Set info = .querySelectorAll("redesignStatusChevronTVC tank-results-item__data-label-large tank-text-center statusChevron_key_status")
    End With

    With Worksheets(3)
        Worksheets(3).Activate '
        For i = 0 To info.Length - 1
           Debug.Print info(i).innerText
        Next i
    End With
    Application.ScreenUpdating = True
End Sub

标签： htmlexcelvbaweb-scraping

解决方案

假设我最终正确阅读了内容，我认为服务器返回的 HTML 不包含您要查找的信息。

要确认这一点，请尝试打印：

InStr(1, sResponse, "redesignStatusChevronTVC tank-results-item__data-label-large tank-text-center statusChevron_key_status", vbTextCompare)

到即时窗口，您应该会看到它返回0（这意味着响应文本中不存在文本）。

您尝试抓取的信息（甚至需要使用 选择的元素.redesignStatusChevronTVC.tank-results-item__data-label-large.tank-text-center.statusChevron_key_status）是通过 JavaScript 动态填充的，并且在您尝试访问它时不存在。

据我所知，网页发出 HTTP POST 请求，服务器返回一些 JSON，它代表与该跟踪号相关的信息。尝试下面的代码（运行过程JustATest），它会尝试发出相同的 HTTP POST 请求：

Option Explicit

Private Sub JustATest()
    MsgBox "Delivery status is: " & GetDeliveryStatusForPackage("475762806100", "en_IN")
End Sub


Private Function GetDeliveryStatusForPackage(ByVal trackingNumber As String, ByVal localeValue As String)
    ' Given a "trackingNumber" and "localeValue", should return the delivery status of that package.
    Dim jsonResponse As String
    jsonResponse = GetFedExJson(trackingNumber, localeValue)

    GetDeliveryStatusForPackage = ExtractDeliveryStatusFromJson(jsonResponse)
End Function


Private Function ExtractDeliveryStatusFromJson(ByVal someJson As String) As String
    ' Should extract the delivery status. This function treats the JSON
    ' encoded string as a string and hence relies on basic string matching.
    Const START_DELIMITER As String = """keyStatus"":"""

    Dim startDelimiterIndex As Long
    startDelimiterIndex = InStr(1, someJson, START_DELIMITER)
    Debug.Assert startDelimiterIndex > 0
    startDelimiterIndex = startDelimiterIndex + Len(START_DELIMITER)

    Dim endDelimiterIndex As Long
    endDelimiterIndex = InStr(startDelimiterIndex + 1, someJson, """", vbBinaryCompare)
    Debug.Assert endDelimiterIndex > 0

    ExtractDeliveryStatusFromJson = Mid$(someJson, startDelimiterIndex, endDelimiterIndex - startDelimiterIndex)
End Function


Private Function GetFedExJson(ByVal trackingNumber As String, ByVal localeValue As String) As String
    ' Should return a JSON-encoded response. The return value can be
    ' passed to a function that parses JSON (if such a function is available for use).
    Dim formToPost As String
    formToPost = CreateFedExForm(trackingNumber, localeValue)

    Const TARGET_URL As String = "https://www.fedex.com/trackingCal/track"

    With CreateObject("MSXML2.XMLHTTP")
        .Open "POST", TARGET_URL, False
        .SetRequestHeader "Connection", "keep-alive"
        .SetRequestHeader "Content-Type", "application/x-www-form-urlencoded"
        .SetRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/79.0.3945.130 Safari/537.36"
        .Send formToPost
        Debug.Assert InStr(1, .ResponseText, "{""TrackPackagesResponse"":{""successful"":true,", vbBinaryCompare)
        GetFedExJson = .ResponseText
    End With
End Function


Private Function CreateFedExForm(ByVal trackingNumber As String, ByVal localeValue As String) As String
    ' Should return a string representing a form of URL encoded name-value pairs.
    Dim data As String
    data = "{""TrackPackagesRequest"":{""appType"":""WTRK"",""appDeviceType"":""DESKTOP"",""supportHTML"":true,""supportCurrentLocation"":true,""uniqueKey"":"""",""processingParameters"":{},""trackingInfoList"":[{""trackNumberInfo"":{""trackingNumber"":""" & trackingNumber & """,""trackingQualifier"":"""",""trackingCarrier"":""""}}]}}"
    CreateFedExForm = "data=" & Application.EncodeURL(data) & "&action=trackpackages&locale=" & Application.EncodeURL(localeValue) & "&version=1&format=json"
End Function
  • 如果它有效，那么该函数GetDeliveryStatusForPackage似乎能够返回给定trackingNumberand的传递状态localeValue。
  • 值得注意的是，服务器返回的 JSON 包含其他信息（您在问题中没有要求，但您可能会发现相关/有用）。在这里发帖太长了，但您可以自己探索它。
  • 我认为有可能在一个请求中获取多个跟踪号的信息。（我这样说是因为在请求TrackPackagesRequest.trackingInfoList中是一个数组——而在响应TrackPackagesResponse.packageList中也是一个数组）。这只是现阶段的假设/理性猜测，但可能会减少您的代码完成所需的时间。
  • 获得支持 JSON 解析的 VBA 模块（ https://github.com/VBA-tools/VBA-JSON ）可能是值得的。我没有打扰，因为您只想要交货状态。但是反序列化响应将是正确的方法（尤其是在访问正确的属性路径方面）。
  • 您可能还想检查管理您使用其网站的条款是否明确禁止网络抓取或任何其他类似活动。

关于无效跟踪号的嵌套keyStatus属性值，请检查属性路径，其中有一个对象。对于无效的跟踪号，它似乎是- 对于有效的跟踪号，和属性似乎都是零长度字符串。"In transit"TrackPackagesResponse.packageList[0].errorList[0]{"code":"1041","message":"This tracking number cannot be found. Please check the number or contact the sender."...codemessage

现在获得我上面提到的 VBA JSON 模块可能会很好，因为有两个errorList对象（在不同的嵌套级别）并且您要确保访问的是正确的对象。

代码中所需的更改可能是首先检查code和的message属性是否TrackPackagesResponse.packageList[0].errorList[0]指示跟踪号无效（message如果无效则返回）。否则，返回TrackPackagesResponse.packageList[0].keyStatus。我现在没有时间实施这些更改。但我认为这是你可以做的事情（除非你真的不确定，在这种情况下让我知道你需要帮助的地方）。

推荐阅读