Home » excel » Excel VBA/JSON to scrape UPS tracking delivery

Excel VBA/JSON to scrape UPS tracking delivery

Posted by: admin May 14, 2020 Leave a comment

Questions:

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

The code I have tried is as follows

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

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

A sample UPS tracking number is 1Z740YX80140148107

Any help would be greatly appreciated.

Thanks

How to&Answers:

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

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