Зациклить массив заголовков с элементами

Question

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

Я пытался добавить массив заголовков, как

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

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

также хочу промо (имя класса "promo_offers") '1st Month Free!' в строке 2 проблема заключается в том, что это промо предоставляется только для определенных ячеек - поэтому данные вводят в заблуждение, и я получаю промо в 1-й ячейке 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

Для чего бы то ни было, т. Е. Промо равно null, соответствующая ячейка должна быть оставлена ​​пустой, следующий элемент должен быть скопирован

Answer 1

Вы можете получить всю эту информацию, используя xmlhttp.

Я беру все элементы li для блоков и зацикливаю те, которые помещают html каждого li в новый 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

---

Выход: