Excel VBA/JSON用于收集UPS跟踪交付的信息
感谢@QHarr的帮助和代码,我从联邦快递、DHL和Startrack获得了跟踪信息。我一直在尝试使用他的代码、UPS跟踪Web服务开发人员指南和跟踪JSON开发人员指南,让UPS在Excel中也能正常工作。JSON转换器代码来自这里 我试过的代码如下Excel VBA/JSON用于收集UPS跟踪交付的信息,json,excel,vba,web-scraping,Json,Excel,Vba,Web Scraping,感谢@QHarr的帮助和代码,我从联邦快递、DHL和Startrack获得了跟踪信息。我一直在尝试使用他的代码、UPS跟踪Web服务开发人员指南和跟踪JSON开发人员指南,让UPS在Excel中也能正常工作。JSON转换器代码来自这里 我试过的代码如下 Public Function GetUPSDeliveryDate(ByVal id As String) As String Dim body As String, json As Object body = "data={"
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()函数时,我得到了一个#值!回复,而不是2019年5月7日的交付日期,因此我猜我有以下错误
GetUPSDeliveryDate = Format$(json("ResponseStatus")("ShipmentType")(1)("DeliveryDate"), "dddd, mmm dd, yyyy")
我也尝试过以下方法,但没有成功
If json("results")(1)("delivery")("status") = "delivered" Then
GetUPSDeliveryDate = json("results")(1)("checkpoints")(1)("date")
Else
GetUPSDeliveryDate = vbNullString
End If
UPS跟踪号样本为1Z740YX80140148107
任何帮助都将不胜感激
谢谢以下是对这一点的模仿。使用的json解析器是jsonconverter.bas:从名为
jsonconverter
的标准模块下载原始代码并添加到该模块中。然后需要转到VBE>工具>引用>添加对Microsoft脚本运行时的引用
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 Developer Guide.pdf包含了使用官方跟踪API进行设置所需的所有知识。从VBA子系统而不是工作表调用函数:这将更容易调试。你真是一个神!!!非常感谢你。我真的很感激。它工作得很好。