VB6如何判断webbrowser中的谷歌地图加载完毕

时间:2021-09-28 23:16:27
url="https://maps.google.com/maps?saddr=8850+Concord+Dr.+Fredonia+NY&daddr=6805+Fox+Run+Crystal+Lake+IL"
WebBrowser1.Navigate URL, False

12 个解决方案

#1


While webBrowser1.Busy
    Sleep 100
    DoEvents
Wend
MsgBox "加载完毕"

#2


不是有个导航完成的事件吗?

#3


引用 1 楼 caozhy 的回复:
While webBrowser1.Busy
    Sleep 100
    DoEvents
Wend
MsgBox "加载完毕"

无效!加载一半就显示提示框了

#4


引用 2 楼 worldy 的回复:
不是有个导航完成的事件吗?

Private Sub WebBrowser1_DocumentComplete(ByVal pDisp As Object, URL As Variant)
If Not (pDisp Is WebBrowser1.Object) Then Exit Sub
Debug.Print URL
End Sub


似乎也不行

#5


另外,如何让其自动显示第2条建议路线?

#6


你要对url进行判断,是不是加载地图的url

#7


引用 6 楼 worldy 的回复:
你要对url进行判断,是不是加载地图的url

Private Sub WebBrowser1_DocumentComplete(ByVal pDisp As Object, URL As Variant)
If Not (pDisp Is WebBrowser1.Object) Then Exit Sub
If URL = myurl Then MsgBox "ok"
End Sub

也不行

#8




Private Sub Command1_Click()
    URL = "https://maps.google.com/maps?saddr=8850+Concord+Dr.+Fredonia+NY&daddr=6805+Fox+Run+Crystal+Lake+IL"
    WebBrowser1.Navigate URL, False
    Do Until WebBrowser1.ReadyState = 4
        DoEvents
    Loop
    Debug.Print WebBrowser1.Document.All.tags("span")(67).innerText & "---" & WebBrowser1.Document.All.tags("span")(68).innerText
End Sub

#9


引用 8 楼 a814153a 的回复:


Private Sub Command1_Click()
    URL = "https://maps.google.com/maps?saddr=8850+Concord+Dr.+Fredonia+NY&daddr=6805+Fox+Run+Crystal+Lake+IL"
    WebBrowser1.Navigate URL, False
    Do Until WebBrowser1.ReadyState = 4
        DoEvents
    Loop
    Debug.Print WebBrowser1.Document.All.tags("span")(67).innerText & "---" & WebBrowser1.Document.All.tags("span")(68).innerText
End Sub


楼上老师这个可行,多谢。
为什么这样不行?
    Do while WebBrowser1.ReadyState <> 4
        DoEvents
    Loop

#10


另外5楼问题如何解决呢?

#11


该回复于2013-10-30 13:12:27被管理员删除

#12


Excel Vba:



Sub 北京_上海线路_谷歌查询()
    Cells.Clear
    Set oDoc = CreateObject("htmlfile")
    Set ms = CreateObject("MSScriptControl.ScriptControl")
    ms.Language = "JScript"
    出发地 = ms.Eval("encodeURIComponent('中国北京市');")
    目的地 = ms.Eval("encodeURIComponent('中国上海市');")
    URL = "https://maps.google.com/maps?f=d&source=s_d&saddr=" & 出发地 & "&daddr=" & 目的地 & "&output=js&hl=zh-CN&geocode=&aq=0&vps=1&vpsrc=0&mra=ls"
    With CreateObject("Msxml2.XMLHTTP")
        .Open "GET", URL, False
        .send
        str1 = "a=" & Split(Split(.responsetext, ",""state"");}")(0), "function onLoad(){w.loadVPage(")(1)
    End With
    ms.AddCode str1
    str2 = ms.Eval("a.panel")
    oDoc.body.innerHTML = str2
    Set r = oDoc.all.tags("li")
    For i = 0 To r.Length - 1
        Debug.Print Replace(r(i).innerText, vbCrLf, ",")    '三条线路
    Next i
    Set r = oDoc.all.tags("table")(2).Rows
    For i = 0 To r.Length - 1 Step 2
        Cells((i + 2) / 2, 1) = r(i).Cells(1).innerText
        Cells((i + 2) / 2, 2) = r(i + 1).Cells(2).innerText
    Next i

    URL = "https://maps.google.com/maps?mra=ai&via=1&saddr=" & 出发地 & "&daddr=32.4133964936869,119.63299054652452+to:" & 目的地 & "&output=dragdir&jsv=466g&sll=35.568417,118.940072&sspn=8.60896,52.954102&vpsrc=0&geocode=FR7jYAId5jzwBim5LBTnllLwNTGKqQ-vIFZiuQ%3BFdSW7gEdXnQhBykxJMnzu5G2NTFllYfnMRjuYg%3BFbmJ3AEdqIo9BykzPPWxQHCyNTGhZMMjlBKVAg"
    With CreateObject("Msxml2.XMLHTTP")
        .Open "GET", URL, False
        .send
        str1 = "a=" & .responsetext
    End With
    ms.AddCode str1
    str2 = ms.Eval("a.alt[0].html")
    oDoc.body.innerHTML = str2
    Set r = oDoc.all.tags("table")(0).Rows
    For i = 0 To r.Length - 1 Step 2
        Cells((i + 2) / 2, 3) = r(i).Cells(1).innerText
        Cells((i + 2) / 2, 4) = r(i + 1).Cells(2).innerText
    Next i

    URL = "https://maps.google.com/maps?mra=ai&via=1&saddr=" & 出发地 & "&daddr=34.78873657097836,117.29354236274957+to:" & 目的地 & "&output=dragdir&jsv=466g&sll=38.548165,118.916016&sspn=9.207238,105.908203&vpsrc=0&geocode=FR7jYAId5jzwBim5LBTnllLwNTGKqQ-vIFZiuQ%3BFYDVEgId5sH9Binv2JQYH4fGNTEcY6pn4AjPJg%3BFbmJ3AEdqIo9BykzPPWxQHCyNTGhZMMjlBKVAg"
    With CreateObject("Msxml2.XMLHTTP")
        .Open "GET", URL, False
        .send
        str1 = "a=" & .responsetext
    End With
    ms.AddCode str1
    str2 = ms.Eval("a.alt[0].html")
    oDoc.body.innerHTML = str2
    Set r = oDoc.all.tags("table")(0).Rows
    For i = 0 To r.Length - 1 Step 2
        Cells((i + 2) / 2, 5) = r(i).Cells(1).innerText
        Cells((i + 2) / 2, 6) = r(i + 1).Cells(2).innerText
    Next i
End Sub

#1


While webBrowser1.Busy
    Sleep 100
    DoEvents
Wend
MsgBox "加载完毕"

#2


不是有个导航完成的事件吗?

#3


引用 1 楼 caozhy 的回复:
While webBrowser1.Busy
    Sleep 100
    DoEvents
Wend
MsgBox "加载完毕"

无效!加载一半就显示提示框了

#4


引用 2 楼 worldy 的回复:
不是有个导航完成的事件吗?

Private Sub WebBrowser1_DocumentComplete(ByVal pDisp As Object, URL As Variant)
If Not (pDisp Is WebBrowser1.Object) Then Exit Sub
Debug.Print URL
End Sub


似乎也不行

#5


另外,如何让其自动显示第2条建议路线?

#6


你要对url进行判断,是不是加载地图的url

#7


引用 6 楼 worldy 的回复:
你要对url进行判断,是不是加载地图的url

Private Sub WebBrowser1_DocumentComplete(ByVal pDisp As Object, URL As Variant)
If Not (pDisp Is WebBrowser1.Object) Then Exit Sub
If URL = myurl Then MsgBox "ok"
End Sub

也不行

#8




Private Sub Command1_Click()
    URL = "https://maps.google.com/maps?saddr=8850+Concord+Dr.+Fredonia+NY&daddr=6805+Fox+Run+Crystal+Lake+IL"
    WebBrowser1.Navigate URL, False
    Do Until WebBrowser1.ReadyState = 4
        DoEvents
    Loop
    Debug.Print WebBrowser1.Document.All.tags("span")(67).innerText & "---" & WebBrowser1.Document.All.tags("span")(68).innerText
End Sub

#9


引用 8 楼 a814153a 的回复:


Private Sub Command1_Click()
    URL = "https://maps.google.com/maps?saddr=8850+Concord+Dr.+Fredonia+NY&daddr=6805+Fox+Run+Crystal+Lake+IL"
    WebBrowser1.Navigate URL, False
    Do Until WebBrowser1.ReadyState = 4
        DoEvents
    Loop
    Debug.Print WebBrowser1.Document.All.tags("span")(67).innerText & "---" & WebBrowser1.Document.All.tags("span")(68).innerText
End Sub


楼上老师这个可行,多谢。
为什么这样不行?
    Do while WebBrowser1.ReadyState <> 4
        DoEvents
    Loop

#10


另外5楼问题如何解决呢?

#11


该回复于2013-10-30 13:12:27被管理员删除

#12


Excel Vba:



Sub 北京_上海线路_谷歌查询()
    Cells.Clear
    Set oDoc = CreateObject("htmlfile")
    Set ms = CreateObject("MSScriptControl.ScriptControl")
    ms.Language = "JScript"
    出发地 = ms.Eval("encodeURIComponent('中国北京市');")
    目的地 = ms.Eval("encodeURIComponent('中国上海市');")
    URL = "https://maps.google.com/maps?f=d&source=s_d&saddr=" & 出发地 & "&daddr=" & 目的地 & "&output=js&hl=zh-CN&geocode=&aq=0&vps=1&vpsrc=0&mra=ls"
    With CreateObject("Msxml2.XMLHTTP")
        .Open "GET", URL, False
        .send
        str1 = "a=" & Split(Split(.responsetext, ",""state"");}")(0), "function onLoad(){w.loadVPage(")(1)
    End With
    ms.AddCode str1
    str2 = ms.Eval("a.panel")
    oDoc.body.innerHTML = str2
    Set r = oDoc.all.tags("li")
    For i = 0 To r.Length - 1
        Debug.Print Replace(r(i).innerText, vbCrLf, ",")    '三条线路
    Next i
    Set r = oDoc.all.tags("table")(2).Rows
    For i = 0 To r.Length - 1 Step 2
        Cells((i + 2) / 2, 1) = r(i).Cells(1).innerText
        Cells((i + 2) / 2, 2) = r(i + 1).Cells(2).innerText
    Next i

    URL = "https://maps.google.com/maps?mra=ai&via=1&saddr=" & 出发地 & "&daddr=32.4133964936869,119.63299054652452+to:" & 目的地 & "&output=dragdir&jsv=466g&sll=35.568417,118.940072&sspn=8.60896,52.954102&vpsrc=0&geocode=FR7jYAId5jzwBim5LBTnllLwNTGKqQ-vIFZiuQ%3BFdSW7gEdXnQhBykxJMnzu5G2NTFllYfnMRjuYg%3BFbmJ3AEdqIo9BykzPPWxQHCyNTGhZMMjlBKVAg"
    With CreateObject("Msxml2.XMLHTTP")
        .Open "GET", URL, False
        .send
        str1 = "a=" & .responsetext
    End With
    ms.AddCode str1
    str2 = ms.Eval("a.alt[0].html")
    oDoc.body.innerHTML = str2
    Set r = oDoc.all.tags("table")(0).Rows
    For i = 0 To r.Length - 1 Step 2
        Cells((i + 2) / 2, 3) = r(i).Cells(1).innerText
        Cells((i + 2) / 2, 4) = r(i + 1).Cells(2).innerText
    Next i

    URL = "https://maps.google.com/maps?mra=ai&via=1&saddr=" & 出发地 & "&daddr=34.78873657097836,117.29354236274957+to:" & 目的地 & "&output=dragdir&jsv=466g&sll=38.548165,118.916016&sspn=9.207238,105.908203&vpsrc=0&geocode=FR7jYAId5jzwBim5LBTnllLwNTGKqQ-vIFZiuQ%3BFYDVEgId5sH9Binv2JQYH4fGNTEcY6pn4AjPJg%3BFbmJ3AEdqIo9BykzPPWxQHCyNTGhZMMjlBKVAg"
    With CreateObject("Msxml2.XMLHTTP")
        .Open "GET", URL, False
        .send
        str1 = "a=" & .responsetext
    End With
    ms.AddCode str1
    str2 = ms.Eval("a.alt[0].html")
    oDoc.body.innerHTML = str2
    Set r = oDoc.all.tags("table")(0).Rows
    For i = 0 To r.Length - 1 Step 2
        Cells((i + 2) / 2, 5) = r(i).Cells(1).innerText
        Cells((i + 2) / 2, 6) = r(i + 1).Cells(2).innerText
    Next i
End Sub