Tracking Packages in Excel
using VBA to track UPS packages
We’ve been shipping hundreds of packages as part of our Detox Me Action Kit project, and we wanted a way to track all of them without having to manually enter their tracking numbers on the UPS website. Through the UPS REST API and some VBA hacking, we were able to retrieve tracking information directly from Excel.
Dependencies
- Download the VBA-JSON library and follow the instructions to reference it ni your spreadsheet.
- An UPS account and a UPS API key, which you can request on their Developer Kit page.
The function works by submitting a request, formatted in JSON, to the UPS REST API tracking endpoint. The response, also in JSON, lists the events (arrivals and departures) linked to the package. The function returns the status of the most recent event. If no events are listed, then it returns “Not Shipped”. If the response has a fault or error, then “Error” is returned.
Function UPS(Tracking, Key, Username, Password)
Dim MyRequest As Object
Dim RequestContents As String
RequestContents = "{"
RequestContents = RequestContents & "'UPSSecurity': {"
RequestContents = RequestContents & " 'UsernameToken': {"
RequestContents = RequestContents & " 'Username': '" & Username & "',"
RequestContents = RequestContents & " 'Password': '" & Password & "'"
RequestContents = RequestContents & " },"
RequestContents = RequestContents & " 'ServiceAccessToken': {"
RequestContents = RequestContents & " 'AccessLicenseNumber': '" & Key & "'"
RequestContents = RequestContents & " }"
RequestContents = RequestContents & "},"
RequestContents = RequestContents & "'TrackRequest': {"
RequestContents = RequestContents & " 'Request': {"
RequestContents = RequestContents & " 'RequestOption': '15',"
RequestContents = RequestContents & " 'TransactionReference': {"
RequestContents = RequestContents & " 'CustomerContext': 'Excel Package Tracker'"
RequestContents = RequestContents & " }"
RequestContents = RequestContents & " },"
RequestContents = RequestContents & " 'InquiryNumber': '" & Tracking & "',"
RequestContents = RequestContents & " 'TrackingOption':'02'"
RequestContents = RequestContents & "}}"
Set MyRequest = CreateObject("WinHttp.WinHttpRequest.5.1")
MyRequest.Open "POST", "https://onlinetools.ups.com/rest/Track"
MyRequest.Send RequestContents
Dim Json As Object
Set Json = JsonConverter.ParseJson(MyRequest.ResponseText)
Debug.Print JsonConverter.ConvertToJson(Json)
If Json.Exists("Fault") Or Json.Exists("Error") Then
UPS = "Error"
Else
Dim Package As Object
Set Package = Json("TrackResponse")("Shipment")("Package")
If TypeOf Package("Activity") Is Collection Then
UPS = Package("Activity")(1)("Status")("Description")
Else
If Package("Activity").Exists("Status") Then
UPS = "Not Shipped"
End If
End If
End If
End Function
You can call the UPS
function from an Excel formula:
=UPS("tracking number", "API key", "UPS username", "UPS password")
Happy tracking!