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

任何帮助将不胜感激.

谢谢

推荐答案

以下是通过模仿

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开发人员指南.pdf包含使用正式的Tracking 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屋！