Excel VBA/JSON 抓取 UPS 跟踪交付答案

【问题标题】：Excel VBA/JSON to scrape UPS tracking deliveryExcel VBA/JSON 抓取 UPS 跟踪交付
【发布时间】：2019-11-15 17:39:37
【问题描述】：

感谢@QHarr 的帮助和代码，我从 Fedex、DHL 和 Startrack 获得了跟踪信息。我一直在尝试使用他的代码和 UPS tracking Web Service Developer Guide 和 Tracking JSON Developer Guides 来让 UPS 在 Excel 中也能正常工作。 JSON转换器代码来自这里https://github.com/VBA-tools/VBA-JSON/blob/master/JsonConverter.bas

我试过的代码如下

Public Function GetUPSDeliveryDate(ByVal id As String) As String
    Dim body As String, json As Object
    body = "data={""TrackPackagesRequest"":{""appType"":""WTRK"",""appDeviceType"":""DESKTOP"",""supportHTML"":true,""supportCurrentLocation"":true,""uniqueKey"":"""",""processingParameters"":{},""trackingInfoList"":[{""trackNumberInfo"":{""trackingNumber"":" & Chr$(34) & id & Chr$(34) & ",""trackingQualifier"":"""",""trackingCarrier"":""""}}]}}"
    body = body & "&action=trackpackages&locale=en_AU&version=1&format=json"

    With CreateObject("MSXML2.XMLHTTP")
        .Open "POST", "http://wwwapps.ups.com/WebTracking", False
        .setRequestHeader "Referer", "https://www.ups.com/track?loc=en_AU&tracknum=" & id
        .setRequestHeader "User-Agent", "Mozilla/5.0"
        .setRequestHeader "X-Requested-With", "XMLHttpRequest"
        .setRequestHeader "Content-Type", "application/x-www-form-urlencoded; charset=UTF-8"
        .send body
        Set json = JSONConverter.ParseJson(.responseText)
    End With
    GetUPSDeliveryDate = Format$(json("ResponseStatus")("ShipmentType")(1)("DeliveryDate"), "dddd, mmm dd, yyyy")
End Function

我没有在代码中得到任何错误，但是当我使用 =GetUPSDeliveryDate() 函数时，我得到一个#VALUE！响应而不是 2019 年 5 月 7 日的交付日期，所以我猜我有以下错误

    GetUPSDeliveryDate = Format$(json("ResponseStatus")("ShipmentType")(1)("DeliveryDate"), "dddd, mmm dd, yyyy")

我也尝试了以下方法，但没有运气。

    If json("results")(1)("delivery")("status") = "delivered" Then
         GetUPSDeliveryDate = json("results")(1)("checkpoints")(1)("date")
    Else
        GetUPSDeliveryDate = vbNullString  
    End If

UPS 跟踪号示例为 1Z740YX80140148107

任何帮助将不胜感激。

谢谢

【问题讨论】：

从 VBA 子程序而不是工作表中调用您的函数：它会更容易调试。

标签： json excel vba web-scraping

【解决方案1】：

以下是模仿这个UPS tracking site。使用的 json 解析器是 jsonconverter.bas：从 here 下载原始代码并添加到名为 jsonConverter 的标准模块中。然后你需要去 VBE > Tools > References > Add reference to Microsoft Scripting Runtime。

Option Explicit

Public Sub test()

    Debug.Print GetUPSDeliveryDate("1Z740YX80140148107")

End Sub
Public Function GetUPSDeliveryDate(ByVal id As String) As String
    Dim body As String, json As Object
    body = "{""Locale"":""en_US"",""TrackingNumber"":[""" & id & """]}"
    With CreateObject("MSXML2.XMLHTTP")
        .Open "POST", "https://www.ups.com/track/api/Track/GetStatus?loc=en_US", False
        .setRequestHeader "Referer", "https://www.ups.com/track?loc=en_US&requester=ST/"
        .setRequestHeader "User-Agent", "Mozilla/5.0"
        .setRequestHeader "DNT", "1"
        .setRequestHeader "Content-Type", "application/json"
        .setRequestHeader "Accept", "application/json, text/plain, */*"
        .send body
        Set json = JsonConverter.ParseJson(.responseText)
    End With
    If json("trackDetails")(1)("packageStatus") = "Delivered" Then
        GetUPSDeliveryDate = json("trackDetails")(1)("deliveredDate")
    Else
        GetUPSDeliveryDate = "Not yet delivered"
    End If
End Function

Tracking Web Service Developer Guide.pdf 包含使用官方跟踪 API 进行设置所需了解的所有内容。

【讨论】：