05
2018
01

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

给大家分享一个自己写的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 

« 上一篇 下一篇 »

评论列表:

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

发表评论:

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

展开