Блог

Я пытаюсь получить мили между 2 почтовыми кодами, которые находятся в 2 ячейках.

Я написал код для открытия веб-страницы и ввода 2 почтовых индексов.

Я не могу заставить его нажать кнопку, а затем взять мили и поместить их в ячейки и перебирать ячейки, пока они не опустеют.

Я пробовал (0) до (7), я думаю, что это 6-я кнопка в html. Я также пробовал разные 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 ячеек и переходили к следующему и делали то же самое, пока ячейки не станут пустыми.

С помощью небольших манипуляций с javascript вы можете легко это сделать. Расстояние по дороге, я думаю, требует службы направления, для которой требуется ключ API. Я предполагаю, что эта веб-страница была создана за несколько дней до того, как Google обновил API-интерфейсы geo, чтобы требовать оплаты ключей 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" amp; 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