Excel VBA 数据抓取 - 并非所有数据都被提取

Question

我最近发布了一个类似的问题，但从那时起我已经能够成功地从网页中抓取一些数据。但是，我遇到了一个问题。尝试从此页面抓取时: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

Answer 1

尝试以下基于类返回 nodeLists 然后索引

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