Excel VBA/JSON 来抓取 UPS 跟踪交付 [英] Excel VBA/JSON to scrape UPS tracking delivery

问题描述

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

Thanks to the help and code from @QHarr I have got the tracking info from Fedex, DHL and Startrack working. I have been trying to use his code and the UPS tracking Web Service Developer Guide and Tracking JSON Developer Guides to get UPS to work as well within Excel. The JSON converter code is from here 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 日的交付日期，所以我猜我有以下错误

I am not getting any errors in the code per-say, but when I use the =GetUPSDeliveryDate() function I am getting a #VALUE! response instead of the delivered date of 7th May 2019, so I am guessing I have got the following bit wrong

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

我也尝试了以下方法，但没有成功.

I have also tried the following, but no luck.

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

示例 UPS 跟踪编号为 1Z740YX80140148107

A sample UPS tracking number is 1Z740YX80140148107

任何帮助将不胜感激.

谢谢

推荐答案

以下是模仿这个UPS 跟踪站点.使用的json解析器是jsonconverter.bas:从此处 并添加到名为 jsonConverter 的标准模块.然后，您需要转到 VBE > 工具 > 参考 > 添加对 Microsoft Scripting Runtime 的参考.

The following is by mimicking of this UPS tracking site. The json parser used is jsonconverter.bas: Download raw code from here and add to standard module called jsonConverter . You then need to go 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 进行设置所需的所有信息.

The Tracking Web Service Developer Guide.pdf contains all you need to know to set up using the official tracking API.

这篇关于Excel VBA/JSON 来抓取 UPS 跟踪交付的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！