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 FunctionYou can call the UPS function from an Excel formula:
=UPS("tracking number", "API key", "UPS username", "UPS password")Happy tracking!
