|
|
楼主 |
发表于 2018-9-3 13:51
|
显示全部楼层
Sub CHAXUN() '查询快递
Dim xmlhttp As Object, str1$, str2$, str3$, str4$
Dim i%, j%
Dim myjson As Variant
Dim mypostdata As String
Application.ScreenUpdating = False
Application.EnableEvents = False
Dim mywinH As Object
Set mywinH = CreateObject("WinHttp.WinHttpRequest.5.1")
Dim myurl As String
Dim myid As String
Dim myappkey As String
myurl = "http://api.kdniao.cc/Ebusiness/EbusinessOrderHandle.aspx" '快递鸟API 测试地址
myid = "1377341" '用户 ID 重要
myappkey = "7a34d8a1-6b02-48e7-8036-90f5e833e02a" 'API key 重要
s = 3
T = 96
For j = s To T
If Cells(j, 8) <> "已签收" And Cells(j, 5) <> "" Then '查询签收状态（H列）
If InStr(1, Cells(j, 4), "速尔", 1) > 0 Then '查询物流方式
str1 = "SURE"
' ElseIf InStr(1, Cells(j, 4), "天天", 1) > 0 Then '查询物流方式
' str1 = "tiantian"
ElseIf InStr(1, Cells(j, 4), "安能", 1) > 0 Then '查询物流方式
str1 = "ANE"
ElseIf InStr(1, Cells(j, 4), "顺丰", 1) > 0 Then '查询物流方式
str1 = "SF"
ElseIf InStr(1, Cells(j, 4), "优速", 1) > 0 Then '查询物流方式
str1 = "UC"
End If
myjson = Chr(123)
myjson = myjson & Chr(34) & "OrderCode" & Chr(34) & Chr(58) & Chr(34) & "" & Chr(34) & Chr(44) '订单编号 非必要
myjson = myjson & Chr(34) & "ShipperCode" & Chr(34) & Chr(58) & Chr(34) & str1 & Chr(34) & Chr(44) '快递公司 必要
myjson = myjson & Chr(34) & "LogisticCode" & Chr(34) & Chr(58) & Chr(34) & Trim(Cells(j, 5).Value & Chr(34)) & Chr(125) '单号 必要
Debug.Print myjson
mydatasign = Base64Encode(MD5(myjson & myappkey, "32"), "utf-8") '制作DataSign
If InStr(1, mydatasign, "77u/", 1) > 0 Then '截取BOM头
mydatasign = Right(mydatasign, Len(mydatasign) - 4)
End If
Dim WriteStream As Object
Set WriteStream = CreateObject("ADODB.Stream")
With WriteStream
.Type = 2
.Open
.Charset = "utf-8"
.WriteText myjson
.Position = 0
.Type = 2
.Charset = "utf-8"
.Position = 3 'skip BOM
.SaveToFile ThisWorkbook.Path & "\1.txt", 2
myjson = .ReadText()
.Close
End With
' myjson02 = WriteStream.ReadText()
Set WriteStream = Nothing
' Debug.Print myjson
' myjson = ByteToUTF16(myjson, "utf-8")
Debug.Print UTF8_Encode(myjson)
mypostdata = "EBusinessID=" & myid & Chr(38) 'User ID
mypostdata = mypostdata & "DataType=2" & Chr(38) 'Data Type 2 = JSON
mypostdata = mypostdata & "RequestType=1002" & Chr(38) 'RequestType 1002 为物流查询接口
mypostdata = mypostdata & "RequestData=" 'requestdata = JSON data set
mypostdata = mypostdata & myjson & Chr(38) & "DataSign=" & Mid(mydatasign, 5)
Debug.Print mypostdata
mywinH.Open "post", "http://api.kdniao.cc/Ebusiness/EbusinessOrderHandle.aspx"
mywinH.setRequestHeader "Content-Type", "application/x-www-form-urlencoded;charset=utf-8"
mywinH.setRequestHeader "Accept-Language", "zh-CN"
mywinH.send mypostdata
myresponse = ByteToUTF16(mywinH.responseBody, "utf-8")
Debug.Print myresponse
Cells(j, 10).Value = myresponse
Cells(j, 11).Value = mywinH.responsetext
' str2 = mywinH.responsetext '取得物流数据
End If
Next
' Columns("H:I").AutoFit '将区域中的列宽和行高调整为最适当的值。
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
主贴可能太长了，大家看得麻烦，这个就是查询，只要传”快递公司名称"和“单号"就行简单多了。关键是UTF-8转码，MD5加密，Base64转码以前从未接触过，不知道怎么来判断步骤是否正确，求大师指点啊。 |
|
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2018-9-1 09:21
