用VBA刮除CDC疫苗接种数据

Question

我试图从以下疾病预防控制中心网站上收集疫苗接种数据：https://covid.cdc.gov/covid-data-tracker/#vaccinations

我试过querySelectorAll，但没有运气。有人能帮我看看吗？非常感谢！

Sub useClassnames()

Dim appIE As Object
Set appIE = CreateObject("internetexplorer.application")

With appIE
    .navigate "https://covid.cdc.gov/covid-data-tracker/#vaccinations"
    .Visible = False
End With

Do While appIE.Busy
    DoEvents
Loop

Set allRowOfData = appIE.document.getElementById("maincontent")
Debug.Print allRowOfData.innerHTML

'Set element = appIE.document.querySelectorAll(".container mt-5")
'For Each elements In element
' Debug.Print elements
'Next elements

'For Each element In allRowOfData
'Debug.Print element
'Next element

End Sub

Answer 1

在这里，只需更改工作表名称或编号:)

Option Explicit
Const updatedCol = 1
Const dosesDistributedColVal = 2
Const peopleInicVaccColVal = 3



Sub useClassnames()
    
    'declare worksheet variable and set headers
    Dim targetWsh As Worksheet: Set targetWsh = ThisWorkbook.Sheets(1)
    targetWsh.Cells(1, 1).Value = "Last Update"
    targetWsh.Cells(1, 2).Value = "Doses Distributed"
    targetWsh.Cells(1, 3).Value = "People Initiating Vaccination"
    
    Dim lstRegisterRow As Long: lstRegisterRow = targetWsh.Range("A" & targetWsh.Rows.Count).End(xlUp).Row + 1
    
    'open IE and navigate to site
    Dim appIE As InternetExplorer: Set appIE = New InternetExplorer
    appIE.navigate "https://covid.cdc.gov/covid-data-tracker/#vaccinations"
    appIE.Visible = False
    While appIE.Busy = True Or appIE.readyState < 4: DoEvents: Wend
    
    Dim oHtmlDoc As HTMLDocument: Set oHtmlDoc = appIE.document
    Dim oHtmlElementColl As IHTMLElementCollection
    
    'Get and write last update date
    Application.Wait (Now + TimeValue("0:00:02")) 'wait 2 secs to avoid error, if recieve error, add seconds as needed
    Set oHtmlElementColl = oHtmlDoc.getElementsByTagName("small")
    targetWsh.Cells(lstRegisterRow, updatedCol) = oHtmlElementColl(0).innerHTML
  
    'Get and write Doses Distributed and People Initiating Vaccination
    Set oHtmlElementColl = oHtmlDoc.GetElementsByClassName("card-number")
    targetWsh.Cells(lstRegisterRow, dosesDistributedColVal) = oHtmlElementColl(0).innerText
    targetWsh.Cells(lstRegisterRow, peopleInicVaccColVal) = oHtmlElementColl(1).innerText
    
    appIE.Quit

End Sub

​

​