按AA Route Planner VBA中的获取路线按钮

时间:2016-09-03 13:11:10

标签: excel vba excel-vba automation explorer

我正在尝试在Internet Explorer中自动化路线规划器搜索。我有以下代码接近我需要的但不是按下" Get Route"按钮它可以找到"找一辆车"而是按钮。一旦我得到那个排序我希望能够以英里为单位获得距离的结果并输入回Excel。感谢。

我想我已经设法找到了我需要选择的元素的代码,但不确定我如何进行任何建议/帮助?

<a href="#" class="getRouteBtn" onclick="onGetRouteClicked(false);return false;" style="background-position: 0px -32px;"><span style="background-position: 100% -32px;">Get route</span></a>

Public Sub route()

Dim startpc As Object
Dim endpc As Object
Dim objie As SHDocVw.InternetExplorer 'microsoft internet controls   (shdocvw.dll)
Dim htmlDoc As MSHTML.HTMLDocument 'Microsoft HTML Object Library
Dim htmlInput As MSHTML.HTMLInputElement
Dim htmlColl As MSHTML.IHTMLElementCollection

Set objie = New SHDocVw.InternetExplorer

With objie
.navigate "http://www.theaa.com/route-planner/index.jsp" ' Main page
.Visible = 1
Do While .readyState <> 4: DoEvents: Loop
Application.Wait (Now + TimeValue("0:00:02"))

Set startpc = objie.document.getElementById("routeFrom")
Set endpc = objie.document.getElementById("routeTo")
startpc.Value = ActiveCell.Value
endpc.Value = ActiveCell.Offset(0, 1).Value
'click Button
Set htmlDoc = .document
Set htmlColl = htmlDoc.getElementsByTagName("input")
Do While htmlDoc.readyState <> "complete": DoEvents: Loop
For Each htmlInput In htmlColl
If Trim(htmlInput.Type) = "submit" Then
htmlInput.Click
Exit For
End If
Next htmlInput
End With
End Sub

PateBin Link

1 个答案:

答案 0 :(得分:0)

在此循环中,您要求程序找到第一个带有&#34;输入&#34;的"submit"元素。标记,然后单击它。

For Each htmlInput In htmlColl
    If Trim(htmlInput.Type) = "submit" Then
        htmlInput.Click
        Exit For
    End If
Next

那不对,因为&#34; Get Route&#34;按钮没有"input"标签, 在Chrome中的Dev工具中查看此元素,它没有可靠的id属性,但您可以使用GetElementsByClassName("getRouteBtn")找到它,或者您可以使用其父div元素有一个ID,如:

'## Here, the .Children(0) will handle the actual button, which is the
'   Div element's first child element
htmlDoc.GetElementByID("getRouteWrapper").Children(0)  

enter image description here

单击该元素后,等待页面加载,生成的距离元素 具有id属性,因此您可以使用GetElementByID("routeDistanceValue")

enter image description here

这似乎有效,但请注意我使用InternetExplorer.Application类代替objie而不是ShDocVw.InternetExplorer

Public Sub route()

Dim startpc As Object
Dim endpc As Object
Dim objie As Object 
Dim htmlDoc As MSHTML.HTMLDocument 'Microsoft HTML Object Library
Dim htmlInput As MSHTML.HTMLInputElement
Dim htmlColl As MSHTML.IHTMLElementCollection

Set objie = CreateObject("InternetExplorer.Application")
With objie
    .navigate "http://www.theaa.com/route-planner/index.jsp" ' Main page
    .Visible = True
    Call ReadyLoop(objie)
    Application.Wait (Now + TimeValue("0:00:02"))

    Set startpc = objie.document.GetElementByID("routeFrom")
    Set endpc = objie.document.GetElementByID("routeTo")
    startpc.Value = ActiveCell.Value
    endpc.Value = ActiveCell.Offset(0, 1).Value
    'click Button
    Set htmlDoc = .document
    'Find the "getRouteBtn"
    Dim btn As Object
    Set btn = htmlDoc.GetElementByID("getRouteWrapper").Children(0)

    If Not btn Is Nothing Then btn.Click
    Call ReadyLoop(htmlDoc)

    'Get the distance item:
    Dim htmlDist As Object
    Set htmlDist = htmlDoc.GetElementByID("routeDistanceValue")
    If Not htmlDist Is Nothing Then
        ActiveCell.Offset(0, 2).Value = htmlDist.InnerText
    Else
        MsgBox "Element 'routDistanceValue' not found!", vbCritical
        GoTo EarlyExit
    End If
End With

Exit Sub
EarlyExit:
End Sub

Sub ReadyLoop(obj As Object)
Do While Not obj.ReadyState = 4 And Not obj.ReadyState = "complete"
    DoEvents
Loop
End Sub