Сохраните несколько элементов в словаре для последующей печати

Question

Я написал скрипт в vba, чтобы вычищать различные категории кофеен с веб-страницы. Категории, которые я пытаюсь проанализировать: shopname, address и phone. Я уже определил селекторы в моем сценарии. Проблема в том, что я не могу сохранить их в словаре, чтобы напечатать их позже.

Если бы это было для двух предметов, я мог бы обращаться с ними так, как я уже показал. Я запутываюсь, когда есть другой элемент, как в телефоне (в настоящее время он закомментирован ниже) вступают в игру.

Как сохранить три словаря в словаре и распечатать их?

Sub GetDictItems()
    Dim key As Variant, Html As New HTMLDocument, URL$, R&
    Dim post As HTMLDivElement, shopName$, address$, phone$
    Dim idic As Object: Set idic = CreateObject("Scripting.Dictionary")

    URL = "https://www.yellowpages.com/search?search_terms=Coffee%20Shops&geo_location_terms=San%20Francisco%2C%20CA&page=2"

    With New XMLHTTP60
        .Open "GET", URL, False
        .setRequestHeader "User-Agent", "Mozilla/5.0"
        .send
        Html.body.innerHTML = .responseText
    End With

    For Each post In Html.getElementsByClassName("info")
        shopName = post.querySelector(".business-name span").innerText
        address = post.querySelector(".adr").innerText
'       phone = post.querySelector(".phones").innerText
        idic(shopName) = address
    Next post

    For Each key In idic.keys
        R = R + 1: Cells(R, 1) = key
        Cells(R, 2) = idic(key)
    Next key
End Sub

Ссылка для добавления для выполнения вышеуказанного скрипта:

Microsoft XML, v6.0
Microsoft HTML Object Library

My intention here to learn as to how I can store multiple items in a dictionary in order to print them later.

Ожидаемый результат:

Answer 1

Мне нравится уже дан ответ (+). Вы также можете загружать массивы в элементы.

For Each post In Html.getElementsByClassName("info")
    shopName = post.querySelector(".business-name span").innerText
    address = post.querySelector(".adr").innerText
    phone = post.querySelector(".phones").innerText
    idic(post) = Array(shopName, address, phone)
Next post

For Each key In idic.keys
    R = R + 1: ActiveSheet.Cells(R, 1) = idic(key)(0)
    ActiveSheet.Cells(R, 2) = idic(key)(1)
    ActiveSheet.Cells(R, 3) = idic(key)(2)
Next key

Вы также можете работать только с массивами, которые должны быть быстрыми.

Dim list As Object, arr(), post As Object, index As Long
Set list = Html.getElementsByClassName("info")
ReDim arr(1 To list.Length)

For Each post In list
    index = index + 1
    shopName = post.querySelector(".business-name span").innerText
    address = post.querySelector(".adr").innerText
    phone = post.querySelector(".phones").innerText
    arr(index) = Array(shopName, address, phone)
Next
For index = LBound(arr) To UBound(arr)
    ActiveSheet.Cells(index, 1).Resize(1, UBound(arr(index))) = arr(index)
Next

Однако я бы хотел загрузить html.getElementsByClassName("info") в переменную и работать с этим в обоих случаях.

---

Кроме того, данные присутствуют в строке json внутри тега script, поэтому при использовании анализатора json, например, jsonconverter.bas Вы также можете сделать:

Dim json As Object, item As Object, results(), i As Long
Set json = JsonConverter.ParseJson(Html.querySelectorAll("script[type='application/ld+json']").item(1).innerHTML)
ReDim results(1 To json.Count)
i = 1
For Each item In json
    results(i) = Array(item("name"), Join$(item("address").Items, " ,"), item("telephone"))
    i = i + 1
Next

Answer 2

Другой возможностью было бы создание простого класса для данных. А затем добавить экземпляры этого класса в словарь. Два дополнительных класса WebData и InfoDataCollection помогут разделить код и улучшить читаемость и т. Д.

метод GetDictItems

Const url = "https://www.yellowpages.com/search?search_terms=Coffee%20Shops&geo_location_terms=San%20Francisco%2C%20CA&page=2"

Sub GetDictItems()
    With New WebData
        .Load url
        .PrintToExcel
    End With
End Sub

Модуль класса WebData

Private m_html As HTMLDocument
Private m_data As InfoDataCollection

Private Sub Class_Initialize()
    Set m_html = New HTMLDocument
    Set m_data = New InfoDataCollection
End Sub

Public Sub Load(url As String)
    With New XMLHTTP60
        .Open "GET", url, False
        .setRequestHeader "User-Agent", "Mozilla/5.0"
        .send
        m_html.body.innerHTML = .responseText
    End With
    m_data.Add m_html
End Sub

Public Sub PrintToExcel()
    Dim key As Variant
    Dim R As Long
    Dim info As InfoData

    For Each key In m_data.Keys
        R = R + 1
        Set info = m_data.Items(key)
        Cells(R, 1) = info.ShopName
        Cells(R, 2) = info.Address
        Cells(R, 3) = info.Phone
    Next key
End Sub

Модуль класса InfoData

Private m_shopName As String
Private m_address As String
Private m_phone As String

Public Property Get ShopName() As String
    ShopName = m_shopName
End Property

Public Property Let ShopName(ByVal vNewValue As String)
    m_shopName = vNewValue
End Property

Public Property Get Address() As String
    Address = m_address
End Property

Public Property Let Address(ByVal vNewValue As String)
    m_address = vNewValue
End Property

Public Property Get Phone() As String
    Phone = m_phone
End Property

Public Property Let Phone(ByVal vNewValue As String)
    m_phone = vNewValue
End Property

Модуль класса InfoDataCollection

Private m_dictionary As Object

Private Sub Class_Initialize()
    Set m_dictionary = CreateObject("Scripting.Dictionary")
End Sub

Public Sub Add(html As HTMLDocument)
    Dim info As InfoData
    Dim post As HTMLDivElement

    m_dictionary.RemoveAll
    For Each post In html.getElementsByClassName("info")
        Set info = New InfoData
        info.ShopName = post.querySelector(".business-name span").innerText
        info.Address = post.querySelector(".adr").innerText
        info.Phone = post.querySelector(".phones").innerText
        Set m_dictionary(info.ShopName) = info
    Next post
End Sub

Public Property Get Keys() As Variant()
    Keys = m_dictionary.Keys
End Property

Public Property Get Items() As Object
    Set Items = m_dictionary
End Property

Answer 3

Кажется, я могу достичь результата, как показано ниже. Я выкину свой ответ, если найдется лучший подход:

For Each post In Html.getElementsByClassName("info")
    shopName = post.querySelector(".business-name span").innerText
    address = post.querySelector(".adr").innerText
    phone = post.querySelector(".phones").innerText
    idic(shopName & "|" & address & "|" & phone) = 1
Next post

For Each key In idic.keys
    R = R + 1: Cells(R, 1) = Split(key, "|")(0)
    Cells(R, 2) = Split(key, "|")(1)
    Cells(R, 3) = Split(key, "|")(2)
Next key