excel批量快递查询求助!!在线等!!!

leospears

我是小白一枚.工作急需用到,并不是伸手党.看了好久的代码了,我基本知道每一块是干什么用的
但是代码不会编辑,不会写.麻烦来个大手帮忙一下B列中有测试用的单号
本人有快递100API,若能用上参数的话会不会更效率一些呢!
每天有上千需要实时跟踪.现在很崩溃.求大触.

leospears

在此奉上附件

wp8680

1. Sub kuaidi()
   
2.     Dim xmlhttp As Object, str1$, str2$, str3$, str4$, arr
   
3.     Dim i%, j%
   
4.     On Error Resume Next
   
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://api.kuaidi100.com/api?id=29833628d495d7a5&com=" & str1 & "&nu=" & Trim(Cells(j, 2).Value)
    
23.                 .setrequestheader "X-Requested-With", "XMLHttpRequest"
    
24.                 .setrequestheader "Referer", "http://www.kuaidi100.com/"
    
25.                 .send
    
26.                 str2 = .responsetext  '取得物流数据
    
27.                 arr = Split(str2, "{""time"":""")
    
28.                 Cells(j, 3) = arr(1)
    
29. '                str3 = Split(Split(str2, "{""time"":""")(2), """,""context"":""")(0) & "  " & Split(Split(str2, """context"":""")(2), """,""ftime"":""")(0)
    
30. '                str4 = Split(Split(str2, "{""time"":""")(1), """,""context"":""")(0) & "  " & Split(Split(str2, """context"":""")(1), """,""ftime"":""")(0)
    
31. '
    
32. '
    
33. '                If InStr(str4, "签收") Then
    
34. '                    Cells(j, 3) = "已签收"
    
35. '                    Cells(j, 4) = Left(str4, 20)
    
36. '                ElseIf InStr(str2, "已收") And InStr(str2, "派件") = 0 Then Cells(j, 3) = "在途中"
    
37. '                ElseIf InStr(str2, "已揽收") And InStr(str2, "派件") = 0 Then Cells(j, 3) = "在途中"
    
38. '                ElseIf InStr(str2, "揽件") And InStr(str2, "派件") = 0 Then Cells(j, 3) = "在途中"
    
39. '                ElseIf InStr(str2, "派件") Then Cells(j, 3) = "派送中"
    
40. '                ElseIf InStr(str2, "参数异常") Then Cells(j, 3) = "暂无记录"
    
41. '                End If
    
42.             End If
    
43.         Next
    
44.     End With
    
45.     Columns("C:D").AutoFit
    
46.     Range("C2:D" & t).HorizontalAlignment = xlLeft
    
47.     Range("D:D").NumberFormatLocal = "yyyy-m-d"
    
48.     Application.ScreenUpdating = True
    
49.     Application.EnableEvents = True
    
50. End Sub
    

复制代码