Как вычеркнуть названия мест с веб-сайта, используя VBA

Question

Я пытаюсь почистить филиалы пикапа с домашней страницы сайта проката автомобилей. Идея состоит в том, чтобы точно определить, где существуют филиалы для данной компании.

Я успешно создал это раньше, но эта компания недавно обновила свой сайт, и теперь мой код не работает. Местоположения веток кажутся скрытыми в какой-то форме, местоположения становятся видимыми в html только после того, как вы щелкнете по пространству местоположений пикапа.

Мой текущий код выглядит следующим образом:

Option Explicit
Private Sub pickuplocations()
    Dim html As Object
    Dim ws As Worksheet
    Dim headers()
    Dim i As Long
    Dim r As Long
    Dim c As Long
    Dim numrows As Long

        Set ws = ThisWorkbook.Worksheets("Europcar Branches(2)")
        Set html = New HTMLDocument

            With CreateObject("MSXML2.XMLHTTP")
            .Open "GET", "https://www.europcar.co.za", False
            .send
            html.body.innerHTML = .responseText   'fetches all html from the website

    Dim pickupbranches As Object
    Dim pickupbranchresults()

        Set pickupbranches = html.getElementById("_location-search-widget_15").getElementsByTagName("span") 
        headers = Array("Pickup Location", "Option value") 'for the ws
        numrows = pickupbranches.Length - 1   'sets the row length

        ReDim pickupbranchresults(1 To numrows, 1 To 2)  'sets array size for the results
            For i = 1 To numrows
                pickupbranchresults(i, 1) = pickupbranches.Item(i).innerText 
                pickupbranchresults(i, 2) = pickupbranches.Item(i).Value    
            Next

        With ws

            .Cells(1, 1).Resize(1, UBound(headers) + 1) = headers 'sets the column headers
            .Cells(2, 1).Resize(UBound(pickupbranchresults, 1), UBound(pickupbranchresults, 2)) = pickupbranchresults 
        End With
            End With
End Sub

Answer 1

Ваш текущий код запрашивает исходный код HTML и пытается его очистить.

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

Имеет смысл почистить страницу, посвященную местоположениям:

https://www.europcar.co.za/rental-locations/

Теперь, если вы перейдете на эту страницу и осмотрите сетевой трафик c в инструментах разработчика вашего браузера ( F12 ) при загрузке страницы, вы увидите, что XHR Запрос отправляется. Выглядит это так:

Если вы go через заголовки и параметры запроса, вы увидите, как URL, тело и Заголовки должны выглядеть следующим образом. В этом конкретном случае параметры отсутствуют, а заголовки не являются необходимыми для успешного выполнения запроса, поэтому все, что вам нужно, - это URL.

Полезная нагрузка ответа в формате json. Вы можете проверить его структуру, используя инструмент, подобный this . Вот как это выглядит:

По сути, JSON состоит из разных стран, каждая страна состоит из провинций, а каждая провинция состоит из соответствующие ветки. Каждая ветвь состоит из всей соответствующей информации.

Для такого анализа ответа вам необходим анализатор JSON (см. В конце этого поста).

TL; DR

Вот как должен выглядеть код:

Option Explicit

Sub getLocations()
Dim req As New WinHttpRequest
Dim url As String, results() As String
Dim sht As Worksheet
Dim responseJSON As Object, country As Object, province As Object, branch As Object
Dim i As Long
Dim rng As Range

Set sht = ThisWorkbook.Worksheets("Name of your Worksheet")
url = "https://www.europcar.co.za/api/rentalLocations/impressLocations"

With req
    .Open "GET", url, False
    .send
    Set responseJSON = JsonConverter.ParseJson(.responseText)
End With

For Each country In responseJSON
    For Each province In country("provinces")
        i = 0
        ReDim results(1 To province("branches").Count, 1 To 5)
        For Each branch In province("branches")
            i = i + 1
            results(i, 1) = country("name")
            results(i, 2) = province("name")
            results(i, 3) = branch("name")
            results(i, 4) = branch("emailAddress")
            results(i, 5) = branch("contactNumber")
        Next branch
        With sht
            Set rng = .Range("A" & .Rows.Count).End(xlUp).Offset(1, 0)
        End With
        rng.Resize(UBound(results, 1), UBound(results, 2)) = results
    Next province
Next country

End Sub

В демонстрационных целях приведенный выше код выводит результаты в следующим образом:

Имея в виду структуру JSON и приведенный мной пример кода, вы можете легко изменить его в соответствии со своими потребностями.

Чтобы код работал, вам нужно добавить следующие ссылки на ваш проект (VBE> Инструменты> Ссылки):

 1. Microsoft WinHTTP Services version 5.1
 2. Microsoft Scripting Runtime

Вам также необходимо добавить this JSON parser для вашего проекта. Следуйте инструкциям по установке в ссылке, и вы должны быть установлены на go.