Excel快递单号查询工具以及源码Function kdcx(kd, orderid)Dim Err, url, kdtime, link, Errcode, StatusSelect Case kd '此处支持的快递公司很多的 Case "申通" kd = "shentong" Case "圆通" kd = "yuantong" Case "优速" kd = "yousu" Case "龙邦" kd = "longbang" Case "城市" kd = "cs" Case Else MsgBox "暂时不支持此快递，可以联系管理员添加！" kdcx = "暂时不支持此快递" 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") '读取页面上指定区域 For i = 0 To (Item.Length - 1) Status = Item.Item(i).getElementsByTagName("status").Item(0).Text If Status = 1 Then kdcx = Status Exit For End If Errcode = Item.Item(i).getElementsByTagName("errcode").Item(0).Text ' kdtime = Item.Item(i).getElementsByTagName("time").Item(0).Text 'link = Item.Item(i).getElementsByTagName("content").Item(0).Text NextElse MsgBox "查询数据还未准备就绪。状态：" & objDom.ReadyState & "。"End IfSet http = NothingSet objDom = NothingSelect Case Errcode Case "0000" Err = "无错误" Case "0001" Err = "传输参数格式有误" Case "0002" Err = "用户编号(uid)无效" Case "0003" Err = "用户被禁用" Case "0004" Err = "授权key无效" Case "0005" Err = "快递代号(id)无效" Case "0006" Err = "访问次数达到最大额度" Case "0007" Err = "查询服务器返回错误" Case Else Err = "查询出现未知错误"End SelectSelect Case Status Case "-1" Status = "未更新的单号" Case "0" Status = "查询异常" Case "1" Status = "暂无记录" Case "2" Status = "在途中" Case "3" Status = "派送中" Case "4" Status = "已签收" Case "5" Status = "拒签收" Case "6" Status = "疑难件" Case "7" Status = "无效单" Case "8" Status = "超时单" Case "9" Status = "签收失败" Case Else Status = "快递状态未知情况"End Selectkdcx = StatusEnd FunctionSub deletebutton() '删除工具栏和菜单的子程序Dim tempbar As CommandBar '定义临时工具栏变量On Error Resume Next '该语句用于忽略错误application.CommandBars("Menu Bar").Reset '重新设置Word XP的主菜单，即删除新建的菜单For Each tempbar In Application.CommandBars '通过“For Each…Next”语句遍历Word XP所有的工具栏If tempbar.Name = "快递查询" Then '如名称和新建的工具栏相同tempbar.Visible = False '设置为不可视tempbar.Delete '删除该工具栏End IfNextEnd SubSub addbutton() '创建工具栏和菜单并设置属性的子程序 Call deletebutton '调用删除工具栏和菜单的子程序 Set Obj_Toolbar = Application.CommandBars.Add("快递查询") '新建工具栏，“快递查询”代表工具栏的名称 Set Obj_Toolbar_button = Obj_Toolbar.Controls.Add(Type:=msoControlButton, ID:=1) '新建工具栏按钮 With Obj_Toolbar_button '设置按钮的属性 .Caption = "查询快递状态" .Style = msoButtonIconAndCaption .FaceId = 1018 .OnAction = "s123" End With With Obj_Toolbar '设置工具栏的属性 .Visible = True '工具栏可视 .Enabled = True '工具栏可用 .Position = msoBarTop '工具栏置顶 End WithEnd SubPRivate Sub s123() ' Call yyy lstRo = Cells(Rows.Count, 1).End(xlUp).Row istart = InputBox("请你输入你想查询的开始行号", "开始行号", "2") If istart = "" Then Exit Sub iend = InputBox("请你输入你想查询的结束行号", "结束行号", lstRo) If iend = "" Then Exit Sub With Cells(1, 11) .Value = "快递状态" .Font.Bold = True .HorizontalAlignment = xlCenter '水平居中 .VerticalAlignment = xlCenter '垂直居中 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 "查询已经完毕！"End Sub
能支持国内多家快递公司快递单号查询，顺丰快递、圆通快递、申通快递、ems等都支持。key可以到快递单号查询网www.aikuaidi.cn上面申请。
调用参数：
参数名称
类型
是否必需
描述
key
string
是
授权密钥，点击此处 [快递API接口申请入口] 即可申请
order
string
是
快递单号，请注意区分大小写
id
string
是
快递代号，如：圆通（yuantong）、申通（shentong），点击此处 [查看完整快递代号]
ord
string
可选
排序规则：asc：按时间旧到新排序，desc：按时间新到旧排序，不传默认值：asc
show
string
可选
返回类型：json：返回json字符串，xml：返回xml字符串，html：返回html字符串，不传默认值：json