按 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
在此循环中,您要求程序找到第一个带有 `"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
我正在尝试在 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
在此循环中,您要求程序找到第一个带有 `"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