Web Scraping by Span tag

Question

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

Url- https://www.leetstorage.com/sizes-and-pricing

Sub TagClassName()

Dim ie As New InternetExplorer, ws As Worksheet

Set ws = ThisWorkbook.Worksheets("Unit Data")
With ie
    .Visible = True
    .Navigate2 "https://www.leetstorage.com/sizes-and-pricing"

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

    Dim listings As Object, listing As Object, headers(), results(), r As Long, c As Long, item As Object
    headers = Array("size")
    Set listings = .document.getElementById("site_content").getElementsByTagName("ul")

    ReDim results(1 To listings.Length, 1 To UBound(headers) + 1)
    For Each listing In listings

        r = r + 1
        On Error Resume Next
        results(r, 1) = listing.getElementsByClassName("font-size-NaN m-font-size-NaN")(0).innerText

        On Error GoTo 0
  Next
    Next
    ws.Cells(1, 1).Resize(1, UBound(headers) + 1) = headers
    ws.Cells(2, 1).Resize(UBound(results, 1), UBound(results, 2)) = results
    .Quit

    End With


End Sub

Answer 1

Вы можете использовать следующее. Требуются дочерние элементы li в родительских элементах ul (неупорядоченный список) с классом innerList

---

Internet Explorer:

Option Explicit
'VBE > Tools > References:
' Microsoft Internet Controls
Public Sub RetrieveInfo()
    Dim IE As InternetExplorer, i As Long, items As Object
    Set IE = New InternetExplorer

    With IE
        .Visible = True
        .Navigate2 "https://www.leetstorage.com/sizes-and-pricing"

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

        Set items = .document.querySelectorAll(".innerList li")

        For i = 0 To items.Length - 1
            With ThisWorkbook.Worksheets("Sheet1")
                .Cells(i + 1, 1) = Trim$(items.item(i).innerText)
            End With
        Next
    End With
End Sub

---

XHR:

Вы можете сделать это быстрее с XHR, если вы предоставите заголовок User-Agent

Option Explicit
Public Sub GetInfo()
    Dim html As HTMLDocument, items As Object, i As Long '<  VBE > Tools > References > Microsoft HTML Object Library
    Set html = New HTMLDocument

    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", "https://www.leetstorage.com/sizes-and-pricing", False
        .setRequestHeader "User-Agent", "Mozilla/5.0"
        .send
        html.body.innerHTML = .responseText
    End With
    Set items = html.querySelectorAll(".innerList li")

    For i = 0 To items.Length - 1
        With ThisWorkbook.Worksheets("Sheet1")
            .Cells(i + 1, 1) = Trim$(items.item(i).innerText)
        End With
    Next
End Sub

---

ul блоки:

Если вы посмотрите на то, что возвращается только именем класса ul, то вы получите 3 блока на странице, которые имеют списки:

---

ul с li:

Взяв только один из этих блоков, чтобы проиллюстрировать эффект добавления в дочерние элементы li с комбинатором-потомком :