点击按钮，刮入循环

Question

我试图在2个单元格中的2个邮政编码之间获取里程。

我编写了代码来打开网页并输入2个邮政编码。

我无法点击按钮，然后将里程数放入细胞中并循环通过细胞直至空白。

我试过（0）到（7），我认为它是html中的第6个按钮。我也尝试了不同的getelements。

'start a new subroutine called SearchBot

Sub SearchBot()

    'dimension (declare or set aside memory for) our variables
    Dim objIE As InternetExplorer 'special object variable representing the IE browser

    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

    'initiating a new instance of Internet Explorer and asigning it to objIE
    Set objIE = New InternetExplorer

    'make IE browser visible (False would allow IE to run in the background)
    objIE.Visible = True

    'navigate IE to this web page (a pretty neat search engine really)
    objIE.navigate "http://www.ukpostcode.net/distance-between-uk-postcodes"

    'wait here a few seconds while the browser is busy
    Do While objIE.Busy = True Or objIE.readyState <> 4: DoEvents: Loop

    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

    'in the search box put cell value
    objIE.document.getElementById("pointa").Value = _
      Sheets("Sheet1").Range("B2").Value

    'wait again for the browser
    Do While objIE.Busy = True Or objIE.readyState <> 4: DoEvents: Loop

    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

    'in the search box put cell "A2" value, the word "in" and cell "C1" value
    objIE.document.getElementById("pointb").Value = _
      Sheets("Sheet1").Range("D2").Value

    'wait again for the browser
    Do While objIE.Busy = True Or objIE.readyState <> 4: DoEvents: Loop

    'code below doesnt    work''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

    'click the 'go' button
   objIE.document.getElementsByTagName("button")(6).Click

    'wait again for the browser
    Do While objIE.Busy = True Or objIE.readyState <> 4: DoEvents: Loop

    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

    'take miles and put in cell

    'add distance to sheet
    Range("e2").Value = getElementsByid("distance")

    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

    'close the browser
    objIE.Quit

    'exit our SearchBot subroutine
End Sub

我希望将里程放在2个邮政编码2个单元格旁边的单元格中，然后移动到下一个并执行相同操作直到单元格为空。

Answer 1

通过一些javascript操作，您可以轻松地执行此操作。我认为道路距离需要方向服务，需要API密钥。我猜这个网页是在谷歌更新地理API之前的几天，要求支付API密钥。

我覆盖窗口警报消息并使用javascript来读取距离的值。

Option Explicit

Public Sub SearchBot()
    Dim objIE As InternetExplorer, ws As Worksheet, lastRow As Long, i As Long

    Set ws = ThisWorkbook.Worksheets("Sheet1")
    Set objIE = New InternetExplorer
    lastRow = ws.Cells(ws.rows.Count, "B").End(xlUp).Row 'Down to first blank. Assumes header in row 1
    Dim postcodes()
    postcodes = ws.Range("B2:D" & lastRow).Value

    With objIE
        .Visible = True
        .Navigate2 "http://www.ukpostcode.net/distance-between-uk-postcodes"

        Do While .Busy = True Or .readyState <> 4: DoEvents: Loop

        .document.parentWindow.execScript "window.alert = function() {};"

        For i = LBound(postcodes, 1) To UBound(postcodes, 1)

            .document.getElementById("pointa").Value = _
                                                          postcodes(i, 1)

            .document.getElementById("pointb").Value = _
                                                         postcodes(i, 3)

            .document.querySelector("[value='Calculate Distance']").Click

            Application.Wait Now + TimeSerial(0, 0, 1)

            .document.parentWindow.execScript "document.title = document.getElementById('distance').value;"

            ws.Cells(i + 1, "E") = .document.Title
        Next
        objIE.Quit
    End With
End Sub