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

Pressing the Get Route button from AA Route Planner VBA

我正在尝试在 Internet Explorer 中自动执行 Route Planner 搜索。我有以下接近我需要的代码,但它没有按下 "Get Route" 按钮,而是选择了 "Find A Car" 按钮。一旦我得到排序,我希望能够得到以英里为单位的距离结果并输入回 Excel。谢谢。

我想我已经设法找到了我需要的元素的代码 select 但不确定我是怎么做到的 advice/help?

<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

在此循环中,您要求程序找到第一个带有 `"input" 标记的 "submit" 元素,然后单击它。

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

不对,因为 "Get Route" 按钮没有 "input" 标签, 在 Chrome 的开发工具中查看此元素,它没有可靠的 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)  

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

这似乎有效,但请注意,我使用 InternetExplorer.Application class 作为 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