VB版本查询快递单号源码

能查询各大快递单号，包括申通快递，圆通快递，韵达快递等国内超过90家以上快递单号查询，

如果想快速搭建一个快递单号查询站我推荐这个，这是地址www.aikuaidi.cn，我分享一个VB

Function kdcx(kd, orderid)
Dim Err, url, kdtime, link, Errcode, Status

Select Case kd  '此处支持的快递公司很多的，我自己就常用这几个。
    Case "申通"
        kd = "shentong"
    Case "圆通"
        kd = "yuantong"
    Case "优速"
        kd = "yousu"
    Case "龙邦"
        kd = "longbang"
    Case "城市"
        kd = "cs"
    Case Else
        MsgBox "暂时不支持此快递，可以联系管理员添加！"
        kdcx = "暂时不支持此快递"
        Exit Function
End Select

Set http = CreateObject("Microsoft.XMLHTTP")
url = "http://www.aikuaidi.cn/rest/?key=29fe1030ceaa49ea8d0d7698efd1fd05&order=" & orderid & "&id=" & kd & "&ord=desc&show=xml"

http.Open "get", url, False
http.send
WebContent = http.responsetext
'MsgBox WebContent

Set objDom = CreateObject("Microsoft.XMLDom")
objDom.async = False
objDom.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
    Next
Else
    MsgBox "查询数据还未准备就绪。状态：" & objDom.ReadyState & "。"
End If
Set http = Nothing
Set objDom = Nothing

Select 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 Select

Select 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 Select

kdcx = Status
End Function

　　

版本的源码给大家，调用方法都有，直接用就可以了！