张文迪的博客

数据分析及数据化运营-BI仪表盘及数据运营项目咨询与实施

物流里程批量查询地图路程查询行驶里程查询

给大家分享一个自己写的VBA里程批量查询的小程序,具体的代码功能是根据百度地图URL中的GET方式进行查询,根据百度地图得到最终里程。


具体的宏代码如下:


Sub 里程查询()
k = [a65535].End(xlUp).Row
On Error Resume Next
For i = 2 To k
CityFrom = Cells(i, 1)
CityTo = Cells(i, 2)
Dim strText As String
Dim URL As String
Dim dis, mtime

URL = "http://map.baidu.com/?"
URL = URL & "qt=nav"
URL = URL & "&c=223"
URL = URL & "&sn=2$$$$$$" & CityFrom & "$$0$$$$"
URL = URL & "&en=2$$$$$$" & CityTo & "$$0$$$$"

With CreateObject("MSXML2.ServerXMLHTTP")
.Open "GET", URL, False
.Send
'等待响应
Do While .readystate <> 4
DoEvents
Loop
strText = .responsetext
dis = Val(Split(strText, """dis"":")(1))
'mtime = Val(Mid(strText, InStrRev(strText, """time"":") + 7))
Cells(i, 3) = dis / 1000
End With
Next
End Sub


附件如下:

链接: https://pan.baidu.com/s/1oguhpKoaiJJGM39wjU7H8A 提取码: 366e 

  • 评论列表:
  •  liuliuliumeimei
     发布于 2019-04-10 17:44:53  回复该评论
  • 您好,我在Excel home这个网站下载了您的附件,直接打开里面的表格,点击按钮运行,提示下标越界,打开代码dis = Val(Split(strText, """dis"":")(1))这句标黄,提示dis=空值,请问如何解决?本人代码小白,求大神帮忙,感激不尽~
    •  admin
       发布于 2019-04-18 09:25:04  回复该评论
    • 在代码第21行strText = .responsetext前面加:
      Do While .readystate 4
      DoEvents
      Loop
  •  admin
     发布于 2019-04-18 09:24:58  回复该评论
  • 在代码第21行strText = .responsetext前面加:
    Do While .readystate 4
    DoEvents
    Loop

发表评论:

◎欢迎参与讨论,请在这里发表您的看法、交流您的观点。

«   2019年7月   »
1234567
891011121314
15161718192021
22232425262728
293031
搜索
网站分类
文章归档
最新留言
控制面板
您好,欢迎到访网站!
  查看权限
友情链接

Powered By Z-BlogPHP 1.5.2 Zero

Copyright 张文迪. 备案号:辽ICP备15006660号-2

展开