用元素循環頭數組

Question

我正在尋找可以與類名一起循環頭數組的代碼，但不能包含標簽名或ID。 這只是為了確保是否不存在任何類，則應將相應的單元格留空，並復制下一個元素。

我試圖添加標題數組

  headers = Array("size", "features", "promo", "in store", "web")

但是它需要與我不想要的標簽名一起循環。

還想要促銷（類名是“ promo_offers ”）“第一個月免費！” 在第2行中，問題在於此促銷僅針對特定單元格提供-因此數據會產生誤導，我在第4個單元格中進行促銷，然后出錯。

但是，我只想復制提供了促銷信息的那些單位的促銷，否則單元格應該為空白或需要設置任何其他值。 下面是代碼...

請提出如何構建代碼。

Sub GetClassNames()

Dim html As HTMLDocument

Dim objIE As Object
Dim element As IHTMLElement
Dim ie As InternetExplorer
Dim elements As IHTMLElementCollection
Dim result As String 'string variable that will hold our result link

Dim count As Long
Dim erow As Long

'initiating a new instance of Internet Explorer and asigning it to objIE
Set objIE = New InternetExplorer

'make IE browser visible (False would allow IE to run in the background)
objIE.Visible = True

'navigate IE to this web page (a pretty neat search engine really)
objIE.navigate "https://www.allstorageonline.com/storage-units/texas/amarillo/all-storage-hardy-115423/#utm_source=GoogleLocal&utm_medium=WWLocal&utm_campaign=115423"

'wait here a few seconds while the browser is busy
Do While objIE.Busy = True Or objIE.readyState <> 4: DoEvents: Loop
count = 0

Set html = objIE.document
Set elements = html.getElementsByClassName("unit_size medium")

For Each element In elements
    If element.className = "unit_size medium" Then
        erow = Sheet2.Cells(Rows.count, 1).End(xlUp).Offset(1, 0).Row
        Cells(erow, 1) = html.getElementsByClassName("unit_size medium")(count).innerText

        Cells(erow, 2) = html.getElementsByClassName("promo_offers")(count).innerText
        count = count + 1      
    End If
Next element
End Sub

對於任何東西，即promo為null，則應將相應的單元格留空，然后復制下一個元素

Answer 1

您可以使用xmlhttp獲取所有信息。

我抓取了盒子的所有li元素，然后循環將每個li的html放入新的HTMLDocument 。 我使用該對象的querySelector方法使用css選擇器獲取每一行中的所有其他項目。 我在On Error Resume Next On Error GoTo 0包裝選擇內容，以掩蓋嘗試訪問不存在的元素（例如，某些行沒有促銷）時的錯誤。 然后，根據需要將這些條目留空。

Option Explicit
Public Sub GetInfo()
    Dim ws As Worksheet, html As HTMLDocument, s As String
    Const URL As String = "https://www.allstorageonline.com/storage-units/texas/amarillo/all-storage-hardy-115423"

    Set ws = ThisWorkbook.Worksheets("Sheet1")
    Set html = New HTMLDocument
    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", URL, False
        .setRequestHeader "User-Agent", "Mozilla/5.0"
        .send
        s = .responseText
        html.body.innerHTML = s

        Dim headers(), results(), listings As Object

        headers = Array("Size", "Features", "Promo", "In store", "Web")
        Set listings = html.querySelectorAll(".li_unit_listing")

        Dim rowCount As Long, numColumns As Long, r As Long, c As Long, item As Long

        rowCount = listings.Length
        numColumns = UBound(headers) + 1

        ReDim results(1 To rowCount, 1 To numColumns)
        Dim html2 As HTMLDocument
        Set html2 = New HTMLDocument
        For item = 0 To listings.Length - 1
            r = r + 1
            html2.body.innerHTML = listings.item(item).innerHTML
            On Error Resume Next
            results(r, 1) = Trim$(html2.querySelector(".unit_size").innerText)
            results(r, 2) = Trim$(html2.querySelector(".features").innerText)
            results(r, 3) = Trim$(html2.querySelector(".promo_offers").innerText)
            results(r, 4) = html2.querySelector(".board_rate").innerText
            results(r, 5) = html2.querySelector("[itemprop=price]").getAttribute("content")
            On Error GoTo 0
        Next

        ws.Cells(1, 1).Resize(1, UBound(headers) + 1) = headers
        ws.Cells(2, 1).Resize(UBound(results, 1), UBound(results, 2)) = results
    End With
End Sub

---

輸出：