Расчистка расстояний между двумя городами с помощью VBA

Question

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

У меня сейчас работаетчерез API Google Maps Distance, но постоянные изменения в их политике и способах оплаты превращаются в настоящую проблему, потому что мы узнали, что инструмент перестал работать, когда нам нужно было его использовать.

Именно поэтому яЯ решил обойти проблему и избавиться от необходимости API.Это мой первый проект Scraping, поэтому я уверен, что есть лучшие способы его кодирования, но мое решение пока таково:

Sub Scrape2()

    Dim IE As Object
    Dim dist As Variant
    Dim URL As String
    Dim i As Integer

    'Creates an Internet Explorer Object
    Set IE = CreateObject("InternetExplorer.application")


    URL = "https://www.entrecidadesdistancia.com.br"

    With IE
        .Visible = False ' "True" makes the object visible
        .navigate URL 'Loads the website

        'Waits until the site's ready
        While IE.Busy
        DoEvents
        Wend

        Do While .Busy
        Loop

        'Selects "origin" field and inserts text
        .Document.getElementById("origem").Value = "Jandira, SP - Brasil"

        'Selects "destination" field and inserts text
        .Document.getElementById("destino").Value = "Cotia, SP - Brasil"

        'Presses the GO button
        For Each Button In .Document.getElementsByTagName("button")
            Button.Click
            Exit For
        Next

        'Waits until the site's ready
        Do While .Busy
        Loop

        Do While .Busy
        Loop

        dist = .Document.getElementById("distanciarota").innerText

        MsgBox (dist)


    End With

    IE.Quit
    Set IE = Nothing


End Sub

Он открывает объект Internet Explorer, вставляет два города (которые я 'Заменим информацией, поступающей из моего инструмента, в конечном итоге) в правильные поля, нажмем GO, загрузим следующую страницу и ДОЛЖНЫ указать нужное мне число в MessageBox (который я заменю на целевую ячейку, когда получу эту работу).

Моя последняя проблема заключалась в том, что половину времени макрос останавливался и объявлял «Ошибка времени выполнения 424»: требуется объект »в этой строке:

.Document.getElementById("origem").Value = "Jandira, SP - Brasil"

Или в этой строке:

dist = .Document.getElementById("distanciarota").innerText

Мне удалось обойти это, вставив еще один период ожидания перед обеими «проблемными» строками, но это замедлило макрос больше, чем хотелось бы.

Тем не менее, теперь это всегдадоходит до конца строки, но когда это происходит, мой MessageBox выходит пустым.

Это информация, которая мне нужна:

<strong id="distanciarota">12.4 km</strong>

С этого сайта: https://www.entrecidadesdistancia.com.br/calcular-distancia/calcular-distancia.jsp

Любая помощь в получении яt в переменную или ячейку рабочего листа будет очень ценным.

Answer 1

#If VBA7 Then  
    Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr) 'For 64 Bit Systems  
#Else  
    Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds as Long) 'For 32 Bit Systems  
#End If

Sub Scrape2()
Dim IE As Object
Dim dist As Variant



Dim URL As String
Dim i As Integer

'Creates an Internet Explorer Object
Set IE = CreateObject("InternetExplorer.application")


URL = "https://www.entrecidadesdistancia.com.br"

With IE
    .Visible = False ' "True" makes the object visible
    .navigate URL 'Loads the website

    'Waits until the site's ready
    While IE.Busy
    DoEvents
    Wend

    Do While .Busy
    Loop

'Add additional delay of 500 milliseconds
Sleep 500

    'Selects "origin" field and inserts text
    .Document.getElementById("origem").Value = "Jandira, SP - Brasil"

    'Selects "destination" field and inserts text
    .Document.getElementById("destino").Value = "Cotia, SP - Brasil"

    'Presses the GO button
    For Each Button In .Document.getElementsByTagName("button")
        Button.Click
        Exit For
    Next

    'Waits until the site's ready
    Do While .Busy
    Loop

    Do While .Busy
    Loop

'Add additional delay of 500 milliseconds
Sleep 500

    dist = .Document.getElementById("distanciarota").innerText

    MsgBox (dist)


End With

IE.Quit
Set IE = Nothing
End Sub

'пожалуйста, дополнительная задержка после навигации и нажатия кнопки.Т.е. активный объект при взаимодействии с сервером.однако после извлечения данных из браузера сервера требуется несколько миллисекунд для рендеринга содержимого HTML.следовательно, добавление дополнительной задержки является наилучшей практикой, чтобы избежать этих ошибок.

Answer 2

Это получает оба измерения расстояния, используя их идентификатор.Я добавил цикл с тайм-аутом для обновления страницы.

Option Explicit
Public Sub GetInfo()
    Dim ie As New InternetExplorer, t As Date, ele As Object, test As String
    Const MAX_WAIT_SEC As Long = 5               '<5 seconds

    With ie
        .Visible = True
        .navigate "https://www.entrecidadesdistancia.com.br"

        While .Busy Or .readyState < 4: DoEvents: Wend

        With .document
            .getElementById("origem").Value = "Jandira, SP - Brasil"
            .getElementById("destino").Value = "Cotia, SP - Brasil"
            .querySelector("[onclick='setRout();']").Click
        End With

        While .Busy Or .readyState < 4: DoEvents: Wend

        t = Timer
        Do
            DoEvents
            On Error Resume Next
            Set ele = ie.document.getElementById("distanciarota")
            test = ele.innerText
            On Error GoTo 0
            If Timer - t > MAX_WAIT_SEC Then Exit Do
        Loop While test = vbNullString
        If Not ele Is Nothing Then
            With ThisWorkbook.Worksheets("Sheet1")
                .Cells(1, 1) = "rodovias " & ele.innerText
                .Cells(2, 1) = "linha reta " & ie.document.getElementById("kmlinhareta").innerText
            End With
        End If
        .Quit
    End With
End Sub

Вы можете использовать querySelector с идентификатором CSS, #, селектор таким же образом, например,

ie.document.querySelector("#distanciarota").innerText