Function kdcx (kd, orderid) Dim Err, url, kdtime, link, Errcode, statusSelect Case kd 'many express delivery companies support Case "Shen Tong" kd = "shentong" Case "yuantong" kd = "yuantong" Case "" kd = "yousu" Case" long bang "kd =" longbang "Case" city "kd =" cs "Case Else MsgBox" does not support this express, you can contact the Administrator to add it! "Kdcx =" this express is not currently supported "Exit FunctionEnd SelectSet http = CreateObject (" Microsoft. XMLHTTP ") url =" http://www.aikuaidi.cn/rest? Key = xxxx & order = "& orderid &" & id = "& kd &" & ord = desc & show = xml "http. open "get", url, Falsehttp. sendWebContent = http. responsetext 'msgbox WebContentSet objDom = CreateObject ("Microsoft. XMLDom ") objDom. async = FalseobjDom. loadXML (WebContent) If objDom. readyState> 2 Then Set Item = objDom. getElementsByTagName ("SyncResponseEntity") 'reads the specified region on the page For I = 0 To (Item. length-1) Status = Item. item (I ). getElem EntsByTagName ("status "). item (0 ). text If Status = 1 Then kdcx = Status Exit For End If Errcode = Item. item (I ). getElementsByTagName ("errcode "). item (0 ). text 'dtime = Item. item (I ). getElementsByTagName ("time "). item (0 ). text 'link = Item. item (I ). getElementsByTagName ("content "). item (0 ). text NextElse MsgBox "data query is not ready yet. Status: "& objDom. ReadyState &". "End IfSet http = NothingSet objDom = NothingSelect Case Errcode Case" 0000 "Err =" no error "Case" 0001 "Err =" Incorrect transmission parameter format "Case" 0002 "Err =" user ID (uid) invalid "Case" 0003 "Err =" user disabled "Case" 0004 "Err =" Authorization key invalid "Case" 0005 "Err =" Courier Code (id) invalid "Case" 0006 "Err =" maximum access limit reached "Case" 0007 "Err =" query server return error "Case Else Err =" unknown query error "End SelectSelect Case status Case "-1" Status = "unupdated Ticket No." Case "0" Status = "query exception Regular "Case" 1 "Status =" no record "Case" 2 "Status =" on the way "Case" 3 "Status =" on delivery "Case" 4 "Status =" accepted "Case" 5 "Status =" REJECTED "Case" 6 "Status =" Troubleshooting "Case" 7 "Status =" invalid ticket "Case" 8 "Status =" timeout ticket "Case" 9 "Status =" failed to sign "Case Else Status =" unknown express delivery Status "End Selectkdcx = StatusEnd FunctionSub deletebutton () 'delete the toolbar and menu subroutine Dim tempbar As commandbar' defines the temporary toolbar variable On Error Resume next'. This statement is used to ignore the Error Application. comm AndBars ("Menu Bar"). reset' Reset the main Menu of Word XP, that is, delete the newly created Menu For Each tempbar In Application. commandbars' through "For Each... The Next statement traverses all the tool bar If tempbar of Word XP. name = "courier query" then'. For example, the Name is the same as the created toolbar tempbar. visible = false' is set to invisible tempbar. delete 'delete This toolbar End IfNextEnd SubSub addbutton () 'create a toolbar and menu and Set the properties of the subroutine Call deletebutton' Call the Delete toolbar and the menu subroutine Set Obj_Toolbar = Application. commandBars. add ("courier query") 'create a toolbar. "courier query" indicates the toolbar name Set Obj_Toolbar_button = Obj_Toolbar.Controls.Add (Type: = msoControlButton, ID: = 1) 'create toolbar button With Obj_Toolbar_button'. Caption = "querying express delivery status ". style = msoButtonIconAndCaption. faceId = 1018. onAction = "s123" End With Obj_Toolbar 'sets the toolbar attributes. visible = true' toolbar Visible. enabled = true' toolbar is available. position = msoBarTop 'toolbar top End WithEnd SubPrivate Sub s123 () 'call yyy lstRo = Cells (Rows. count, 1 ). end (xlUp ). row istart = InputBox ("Enter the start line number you want to query", "start line number", "2 ") if istart = "" Then Exit Sub iend = InputBox ("Enter the end line number you want to query", "end Bundle row number ", lstRo) If iend =" "Then Exit Sub With Cells (1, 11 ). value = "express delivery status ". font. bold = True. horizontalAlignment = xlCenter 'horizontally centered. verticalAlignment = xlcenter' vertically center End With For Ro = istart To iend If Cells (Ro, 9) <> "" And Cells (Ro, 10) <> "" Then Cells (Ro, 11 ). value = kdcx (Cells (Ro, 9), Cells (Ro, 10) End If Next Ro MsgBox "query has been completed! "End Sub
Support domestic express delivery companies to query express order numbers, SF Express, yuantong Express, Shentong express, EMS, and so on.
You can apply for the key on www.aikuaidi.cn.
Call parameters:
Parameter Name |
Type |
Required |
Description |
Key |
String |
Yes |
Authorization key. Click here [express delivery API application portal] to apply |
Order |
String |
Yes |
Express waybill number, please note case sensitive |
Id |
String |
Yes |
Courier Code, such as yuantong g and shentong. Click here [View complete Courier Code] |
Ord |
String |
Optional |
Sorting rules: Asc: sort by time to new, Desc: sort by time, If this parameter is left blank, the default value is asc. |
Show |
String |
Optional |
Return type: Json: returns a json string, Xml: returns an xml string, Html: returns an html string, Default Value: json |