Excel VBA/JSON to scrape UPS tracking delivery

后端 未结 1 680
离开以前
离开以前 2021-01-15 22:32

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 Ser

1条回答
  •  [愿得一人]
    2021-01-15 22:50

    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.

    0 讨论(0)
提交回复
热议问题