Excel VBA очистка данных - не все данные извлекаются - PullRequest
1 голос
/ 05 июня 2019

Недавно я опубликовал аналогичный вопрос, но с тех пор я смог успешно очистить некоторые данные с веб-страниц.Однако я столкнулся с проблемой.При попытке вычистить с этой страницы: https://www.scpcn.ca/clinics

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

Еще более странно то, что это сработало один раз, потянув все клиники и около половины адресов, когда я удалил это и попытался запустить снова, я получил только первые 10 клиник, и вот где сейчас.

Я думал, что проблема была в том, что страница не ждала достаточно долго, поэтому я добавил таймер ожидания, но это, похоже, ничего не дало.

Option Explicit

Sub GetSouthClinicData()

    Dim objIE As InternetExplorer
    Dim clinicEle As Object
    Dim clinicAdd As Object

    Dim clinicName As String
    Dim clinicAddress As String
    Dim y As Integer
    Dim x As Integer

    Set objIE = New InternetExplorer
    objIE.Visible = True

    objIE.Navigate "https://www.scpcn.ca/clinics"
    While objIE.Busy = True Or objIE.readyState <> 4: DoEvents: Wend
    Application.Wait (Now + TimeValue("0:00:5"))

    y = 2

    For Each clinicEle In objIE.document.getElementsByClassName("clinic-title")
        clinicName = clinicEle.getElementsByTagName("a")(0).innerText
        Sheets("Sheet3").Range("A" & y).Value = clinicName
        y = y + 1
    Next

    x = 2
        For Each clinicEle In objIE.document.getElementsByClassName("toggle-address clinic-address")
        clinicAddress = clinicEle.getElementsByTagName("br")(0).innerText
        Sheets("Sheet3").Range("B" & x).Value = clinicAddress
        x = x + 1
    Next

    objIE.Quit
End Sub

1 Ответ

2 голосов
/ 05 июня 2019

Попробуйте следующее, которое возвращает нодлисты, основанные на классе, а затем индексирует в

Option Explicit
Public Sub GetInfo()
    Dim html As HTMLDocument
    Set html = New HTMLDocument
    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", "https://www.scpcn.ca/clinics", False
        .send
        html.body.innerHTML = .responseText
        Dim names As Object, addresses As Object, i As Long
        Set names = html.querySelectorAll(".clinic-title")
        Set addresses = html.querySelectorAll(".clinic-address")
        For i = 0 To names.Length - 1
            With ActiveSheet
                .Cells(i + 1, 1) = names.item(i).innerText
                .Cells(i + 1, 2) = addresses.item(i).innerText
            End With
        Next
    End With
End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...