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密钥。我猜这个页面是Google更新地理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

单击按钮，刮入循环

1 个答案: