如何获取百度地图中的距离？

我也是马甲

如图，我在百度中这样查询后，如何返回它的这个公里数？有比较多的数据，麻烦各位看看

我也是马甲

顶一下。。。

我也是马甲

哪位老师帮忙看一看，谢谢

blanksoul12

看了,找到距離,但找不到時間,應該說找出來的很奇怪..........

wcymiss

blanksoul12 发表于 2014-11-5 12:52
看了,找到距離,但找不到時間,應該說找出來的很奇怪..........

blanksoul12

1. Sub Main() '主體代碼
   
2.     Dim strText As String
   
3.     Dim objJSON As Object
   
4.     URL = "http://map.baidu.com/?"
   
5.     URL = URL & "&qt=nav"
   
6.     URL = URL & "&da_src=pcmappg.searchBox.button"
   
7.     URL = URL & "&c=1"
   
8.     URL = URL & "&sn=" & Escape("2$$$成都市$0$$")
   
9.     URL = URL & "&en=" & Escape("2$$$杭州市$0$$")
   
10.     With CreateObject("MSXML2.XMLHTTP")
    
11.         .Open "GET", URL & "&t=" & Rnd(), False
    
12.         .send
    
13.         strText = .responseText
    
14.         CopyToClipbox strText
    
15.     End With
    
16.    
    
17.     With CreateObject("msscriptcontrol.scriptcontrol")
    
18.         .Language = "JavaScript"
    
19.         .AddCode "var mydata=" & strText
    
20.         Set objJSON = .CodeObject
    
21.     End With
    
22.     Set temp_call = CallByName(objJSON.mydata, "content", VbGet)
    
23.     Debug.Print temp_call.dis
    
24.     temp_time = CallByName(temp_call, "time", VbGet)
    
25.     Debug.Print temp_time
    
26.     Debug.Print temp_time / 3600
    
27. End Sub
    
28. Public Function Escape(ByVal strText As String) As String     '如果值中?有非英文和?字，?需??成%形式
    
29.     Set JS = CreateObject("msscriptcontrol.scriptcontrol")
    
30.     JS.Language = "JavaScript"
    
31.     Escape = JS.Eval("encodeURI('" & Replace(strText, "'", "\'") & "');")
    
32. End Function

复制代码

我只真入這些,可以嗎? 但找出來的時間次次不同的,不明白

我也是马甲

blanksoul12 发表于 2014-11-5 15:07
我只真入這些,可以嗎? 但找出來的時間次次不同的,不明白

老师，好，这个报错，是不是你是繁体的原因？我是简体的

我也是马甲

wcymiss 发表于 2014-11-5 14:26

老师好，这个动态的参数两个地方要修改哪里能否给个连接，我去修改两个地址就行

我也是马甲

顶一下。。。

wcymiss

我也是马甲 发表于 2014-11-5 16:36
老师好，这个动态的参数两个地方要修改哪里能否给个连接，我去修改两个地址就行

1. Sub Main()
   
2.     Const CityFrom As String = "成都"
   
3.     Const CityTo As String = "杭州"
   
4.     Dim strText As String
   
5.     Dim URL As String
   
6.     Dim dis, mtime
   
7.    
   
8.     URL = "http://map.baidu.com/?"
   
9.     URL = URL & "qt=nav"
   
10.     URL = URL & "&c=223"
    
11.     URL = URL & "&sn=2$$$$$$" & CityFrom & "$$0$$$$"
    
12.     URL = URL & "&en=2$$$$$$" & CityTo & "$$0$$$$"
    
13.    
    
14.     With CreateObject("MSXML2.XMLHTTP")
    
15.         .Open "GET", URL, False
    
16.         .Send
    
17.         strText = .responsetext
    
18.         dis = Val(Split(strText, """dis"":")(1))
    
19.         mtime = Val(Mid(strText, InStrRev(strText, """time"":") + 7))
    
20.         MsgBox "约" & Format(dis / 1000, "0.00公里/") & Format(mtime / 86400, "hh小时nn分钟")
    
21.     End With
    
22. End Sub

复制代码