从Excel导出后的在线搜索栏值未单击自动标记识别错误

Question

我正在正常运行的网页上在线导出两个单元格的值。但是，我必须手动按回车键，因为单击不会在 ElementbyId 标签选择("位置搜索文本框"(中自动工作。 病房后，我手动按回车键并检查元素以将高程结果导入回 excel。

我需要帮助来自动化最后两个步骤。我是学习标签类、ID 名称等的新手。可能由于无知而选择错误。感谢帮助。

Sub elevation_finder()
Dim elevation As Long
Dim ieobject As InternetExplorer
Dim htmlElement As IHTMLElement
Dim i As Integer
i = 1
Set ieobject = New InternetExplorer
ieobject.Visible = True
ieobject.navigate "https://www.freemaptools.com/elevation-finder.htm"
Application.Wait Now + TimeValue("00:00:05")
With ActiveWorkbook.Sheets("Header")
ieobject.document.getElementById("locationSearchTextBox").Value = _
.Range("B2").Value & "," & .Range("C2").Value
ieobject.document.getElementById("locationSearchTextBox").Click
ieobject.document.getElementById("0EGu2eqKt6").Click
End With
End Sub

Answer 1

我解决了循环的时序问题。这应该做你想要的。我已经一次性用近 2.000 个坐标对其进行了测试。请仔细阅读评论：

Sub ElevationFinder()
'Columns
Const colLat As Long = 2     'Latitude
Const colLon As Long = 3     'Longitude
Const colEleInM As Long = 4  'Elevation in meter
Const colEleInFt As Long = 5 'Elevation in feet
Const url As String = "https://www.freemaptools.com/elevation-finder.htm"
Dim browser As Object
Dim htmlDoc As Object
Dim nodeDropDown As Object
Dim nodeSearchTextBox As Object
Dim nodeSubmitButton As Object
Dim nodeClearMapButton As Object
Dim nodeElevationLabel As Object
Dim tableLongLat As Worksheet
Dim currentRow As Long
Dim coords As String
Dim elevation As String
Dim splitArray() As String
Dim timeout As Double
Dim start As Double
start = Timer
Set tableLongLat = Sheets("Header") 'Table with coords
currentRow = 2 'Start row
'Jump to first row for visual monitoring
tableLongLat.Cells(currentRow, 1).Select
'Initialize Internet Explorer, set visibility,
'call URL and wait until page is fully loaded
Set browser = CreateObject("internetexplorer.application")
browser.Visible = False 'If you want to see what happens in IE, set this to True
browser.navigate url
Do Until browser.ReadyState = 4: DoEvents: Loop
'Manual break to load the map (dynamic content)
'The last three values are hours, minutes, seconds
Application.Wait (Now + TimeSerial(0, 0, 5))
'Shortening the call of the html document
Set htmlDoc = browser.document
'Get dropdown for selecting what to search for
'The default setting is "Latitude,Logitude", but when we switch to another entry,
'the required "Estimate Elevation" button to send the request appears. After that
'we switch back to "Latitude,Logitude". The button remains in place
Set nodeDropDown = htmlDoc.getElementById("locationSearchSelect")
'Select "Free Text Search" and trigger the change event of the dropdown
'Triggering is necessary because otherwise the change will not be recognized
'by the page and the button will not appear
nodeDropDown.selectedIndex = 5
Call TriggerEvent(htmlDoc, nodeDropDown, "change")
'Switch back to "Latitude,Logitude"
nodeDropDown.selectedIndex = 0
Call TriggerEvent(htmlDoc, nodeDropDown, "change")
'Get input field for search text
Set nodeSearchTextBox = htmlDoc.getElementById("locationSearchTextBox")
'Get "Estimate Elevation" button
Set nodeSubmitButton = htmlDoc.getElementById("locationSearchButton")
'Get the button to clear the map from last set coords
'There are 5 buttons on the page with the css class "fmtbutton"
'The third is the button to clear the map (index of a node list begins at 0)
Set nodeClearMapButton = htmlDoc.getElementsByClassName("fmtbutton")(2)
'Go through all rows filled with coords
Do While tableLongLat.Cells(currentRow, colLat).Value <> ""
'Scroll for visual monitoring
If currentRow > 14 Then
ActiveWindow.SmallScroll down:=1
End If
'Get coords of current row
coords = tableLongLat.Cells(currentRow, colLat).Value & "," & tableLongLat.Cells(currentRow, colLon).Value
'Enter coords to search field
nodeSearchTextBox.Value = coords
'Click "Estimate Elevation" button
nodeSubmitButton.Click
'Get elevation from label on map
'The elevation also appears above the search field,
'but there it is more difficult to read the value
'
'Start time for timeout if coordinates are invalid
timeout = Timer
'
'To retrieve multiple elevation information from the map,
'coordinates must be set and deleted alternately. Since
'setting coordinates takes different amounts of time and
'it also takes different amounts of time to delete coordinates
'from the map, loops are used. These ensure that the shortest
'possible time periods are used. This has something to do with
'server communication. The alternative would be to set a blanket
'pause, which would slow down the macro a lot, because the
'estimated maximum value would have to be used
Do
'At first we try to get the label
Set nodeElevationLabel = htmlDoc.getElementsByClassName("leaflet-tooltip")(0)
'Then we try to read out the text
'If no label was there yet, no text
'can be read out. Therefore, error
'handling is temporarily switched off
On Error Resume Next
elevation = Trim(nodeElevationLabel.innertext)
On Error GoTo 0
'Let the loop run until either a elevation information
'has been read out or the timeout takes effect
Loop Until elevation <> "" Or Timer - timeout > 5 'Timeout in seconds
If elevation <> "" Then
'Elevation information come as string: 210.0 m / 689.0 feet
'The two values will be separated
splitArray = Split(elevation, "/")
splitArray(0) = Trim(Replace(splitArray(0), "m", ""))
splitArray(1) = Trim(Replace(splitArray(1), "feet", ""))
'Write the elevation in meter to the Excel sheet
tableLongLat.Cells(currentRow, colEleInM).NumberFormat = "#,##0.0 ""m"""
tableLongLat.Cells(currentRow, colEleInM).Value = splitArray(0)
'Write the elevation in feet to the Excel sheet
tableLongLat.Cells(currentRow, colEleInFt).NumberFormat = "#,##0.0 ""ft"""
tableLongLat.Cells(currentRow, colEleInFt).Value = splitArray(1)
'Click the clear map button
nodeClearMapButton.Click
'The loop mechanism, as explained above
'No timeout necessary, because the label
'will be gone in any case
Do
Set nodeElevationLabel = htmlDoc.getElementsByClassName("leaflet-tooltip")(0)
Loop Until nodeElevationLabel Is Nothing
End If
'Prepare for next coords
elevation = ""
Erase splitArray
currentRow = currentRow + 1
Loop
'Clean up
browser.Quit
'MsgBox Timer - start
End Sub

触发更改事件的过程如下：

Private Sub TriggerEvent(htmlDocument As Object, htmlElementWithEvent As Object, eventType As String)
Dim theEvent As Object
htmlElementWithEvent.Focus
Set theEvent = htmlDocument.createEvent("HTMLEvents")
theEvent.initEvent eventType, True, False
htmlElementWithEvent.dispatchEvent theEvent
End Sub