表格中快递单号如何返回kuai100.com的查询结果呢？

任我逍遥

是否签收查询.zip (7.31 KB, 下载次数: 1063)

2016-1-18 21:15 上传

点击文件名下载附件

如何不用一个个在http://www.kuaidi100.com/查询是否签收而直接渠道是否签到的数据呢？

huang1314wei

1. Sub kuaidi()
   
2.     Dim xmlhttp As Object, str1$, str2$, str3$, str4$
   
3.     Dim i%, j%
   
4.    
   
5.     lstro = Cells(Rows.Count, 2).End(xlUp).Row
   
6.     s = Application.InputBox("请你输入你想查询的开始行号" & Chr(13) & Chr(13) & "查询前请先保存订单表，防止出现未响应而意外关闭未保存" & Chr(13) & Chr(13) & "为避免快递100查询限制，每次查询不要超过100个，2小时内不能频繁查询", "输入开始行号", 2, Type:=1)
   
7.     If s = False Then Exit Sub
   
8.     If s > lstro Then MsgBox "开始行号不能大于表格中已使用的总行数!": Exit Sub
   
9.     t = Application.InputBox("请你输入你想查询的结束行号" & Chr(13) & Chr(13) & "为避免快递100查询限制，每次查询不要超过100个，2小时内不能频繁查询", "输入结束行号", lstro, Type:=1)
   
10.     If t = False Then Exit Sub
    
11.     If t < s Then MsgBox "结束行号不能小行开始行号！": Exit Sub
    
12.     Application.ScreenUpdating = False
    
13.     Application.EnableEvents = False
    
14.    
    
15.     Set xmlhttp = CreateObject("WinHttp.WinHttpRequest.5.1")
    
16.     With xmlhttp
    
17.      For j = s To t
    
18.       If Cells(j, 2) <> "" And Cells(j, 3) <> "已签收" Then
    
19.         .Open "POST", "http://www.kuaidi100.com/autonumber/autoComNum?text=" & Trim(Cells(j, 2).Value)
    
20.         .send    'post请求，目的是获得快递公司名称
    
21.         str1 = Split(Split(.responsetext, "comCode"":""")(2), """")(0)
    
22.         .Open "GET", "http://www.kuaidi100.com/query?type=" & str1 & "&postid=" & Trim(Cells(j, 2).Value)
    
23.         .setrequestheader "X-Requested-With", "XMLHttpRequest"
    
24.         .setrequestheader "Referer", "http://www.kuaidi100.com/"
    
25.         .send
    
26.         str2 = .responsetext  '取得物流数据
    
27.         str3 = Split(Split(str2, "{""time"":""")(2), """,""context"":""")(0) & "  " & Split(Split(str2, """context"":""")(2), """,""ftime"":""")(0)
    
28.         str4 = Split(Split(str2, "{""time"":""")(1), """,""context"":""")(0) & "  " & Split(Split(str2, """context"":""")(1), """,""ftime"":""")(0)
    
29.         If InStr(str4, "签收") Then
    
30.             Cells(j, 3) = "已签收"
    
31.             Cells(j, 4) = Left(str4, 20)
    
32.         ElseIf InStr(str2, "已收") And InStr(str2, "派件") = 0 Then Cells(j, 3) = "在途中"
    
33.         ElseIf InStr(str2, "已揽收") And InStr(str2, "派件") = 0 Then Cells(j, 3) = "在途中"
    
34.         ElseIf InStr(str2, "揽件") And InStr(str2, "派件") = 0 Then Cells(j, 3) = "在途中"
    
35.         ElseIf InStr(str2, "派件") Then Cells(j, 3) = "派送中"
    
36.         ElseIf InStr(str2, "参数异常") Then Cells(j, 3) = "暂无记录"
    
37.         End If
    
38.       End If
    
39.      Next
    
40.     End With
    
41.     Columns("C:D").AutoFit
    
42.     Range("C2:D" & t).HorizontalAlignment = xlLeft
    
43.     Range("D:D").NumberFormatLocal = "yyyy-m-d"
    
44.     Application.ScreenUpdating = True
    
45.     Application.EnableEvents = True
    
46. End Sub

复制代码

huang1314wei

附件参考：

快递批量查询.rar (20.5 KB, 下载次数: 1502)

2016-1-18 22:18 上传

点击文件名下载附件

任我逍遥

huang1314wei 发表于 2016-1-18 22:18
附件参考：

谢谢，看起来就很高端，使用过程中经常会弹出 下标越界的错误，不知道什么原因呢？例如弹出的对话框第一个输入2，之后输入17就会弹出了，输入两个2也是一样，可以帮忙再看下吗？

任我逍遥

谢谢你解决我的问题，感谢，可以帮忙加上容错机制吗？就是个别单号可能错误查不了，不要中断，继续执行其余可以查询的，可以吗？http://club.excelhome.net/forum. ... p;page=1#pid8535115

huang1314wei

任我逍遥 发表于 2016-4-5 15:43
谢谢你解决我的问题，感谢，可以帮忙加上容错机制吗？就是个别单号可能错误查不了，不要中断，继续执行其余 ...

在代码开始处加一句On error resume next

任我逍遥

huang1314wei 发表于 2016-4-5 18:06
在代码开始处加一句On error resume next

谢谢你，好强大，可以增加一种返回结果，下图所示吗？ 返回 暂无查询记录

任我逍遥

另外可以直接返回根据单号查询的快递公司的名字，用什么代码呢？刚才加了那句容错代码，完美解决问题了，谢谢

bajifeng

加一句On error resume next

huang1314wei

任我逍遥 发表于 2016-4-5 21:36
另外可以直接返回根据单号查询的快递公司的名字，用什么代码呢？刚才加了那句容错代码，完美解决问题了，谢 ...

str1 = Split(Split(.responsetext, "comCode"":""")(2), """")(0)  这一句代码就是返回快递公司名称的，以拼音表示的