Получить данные из URL с помощью Excel VBA

Question

Я хочу извлечь данные из URL .

Я хочу данные в столбце Excel.

Название названия (изображения 1 и 2)
УлицаAddress
AddressLocality
почтовый индекс
адрес_региона
адрес страны

Изображение 1

Изображение 2

Вот мой код.

url = Sheets("ExtData").Range("A" & N).Value
With CreateObject("MSXML2.XMLHTTP")
    .Open "GET", url, False
    .setRequestHeader "If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT"
    .send
    sResponse = StrConv(.responseBody, vbUnicode)
End With

Set html = New HTMLDocument
Dim titles As Object, addresses As Object, storesTextToDecipher As Object
With html
    .body.innerHTML = sResponse

    Set titles = .querySelectorAll(".jcn [title]")
    Set addresses = .querySelectorAll(".desk-add.jaddt")

    Til = titles.Item(i).outerHTML
    Add = addresses.Item(i).innerText
    Sheets("ExtData").Range("B" & N) = .getElementsByClassName("Title").Item(0)
    Sheets("ExtData").Range("C" & N) = .getElementById("comp_add").outerHTML
    Range("A" & N + 1).Select
End With

Answer 1

Вы можете использовать селектор класса CSS

Option Explicit
Public Sub GetInfo()
    Dim html As HTMLDocument
    Set html = New HTMLDocument                  '<  VBE > Tools > References > Microsoft Scripting Runtime
    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", "https://www.justdial.com/Agartala/Abhay-Varieties-Nor-Banamalipu/9999PX381-X381-141028162716-U1Z5_BZDET", False
        .send
        html.body.innerHTML = .responseText
    End With
    Debug.Print html.querySelector(".ph_hdr").innerText
End Sub

Если вы хотите разделить строки, используйте

Dim items() As String, i As Long
items = Split(html.querySelector(".ph_hdr").innerText, ", ")
For i = LBound(items) To UBound(items)
    If items(i) <> vbNullString Then
        Activesheet.Cells(i + 1, 1) = items(i)
    End If
Next

---

Странная ситуация заключается в том, что обычно я собираю все теги скрипта с помощью json, используя селектор css script\[type='application/ld+json'\] и цикл, в котором ищется информация ₁ . Однако, несмотря на наличие информации, когда я просматриваю текстовый файл, в момент, когда я использую DOM-парсер, я не могу найти эту информацию. Итак, как бы мне не хотелось отстаивать регулярные выражения с помощью html, вот решение для регулярных выражений:

Option Explicit
Public Sub GetInfo()
    Dim html As HTMLDocument, s As String, re As Object
    Set re = CreateObject("vbscript.regexp")
    Set html = New HTMLDocument                  '<  VBE > Tools > References > Microsoft Scripting Runtime
    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", "https://www.justdial.com/Agartala/Abhay-Varieties-Nor-Banamalipu/9999PX381-X381-141028162716-U1Z5_BZDET", False
        .send
        s = .responseText
        html.body.innerHTML = s
        Debug.Print html.querySelector(".fn").innerText
        Debug.Print Trim$(Replace$(GetString(re, s, "title>(.*)<"), Chr$(34), vbNullString))
        Debug.Print Trim$(Replace$(GetString(re, s, "streetAddress"":(.*"")"), Chr$(34), vbNullString))
        Debug.Print Trim$(Replace$(GetString(re, s, "addressLocality"":(.*"")"), Chr$(34), vbNullString))
        Debug.Print Trim$(Replace$(GetString(re, s, "postalCode"":(.*"")"), Chr$(34), vbNullString))
        Debug.Print Trim$(Replace$(GetString(re, s, "addressRegion"":(.*"")"), Chr$(34), vbNullString))
        Debug.Print Trim$(Replace$(GetString(re, s, "addressCountry"":(.*"")"), Chr$(34), vbNullString))
    End With
End Sub

Public Function GetString(ByVal re As Object, ByVal inputString As String, ByVal pattern As String) As Variant
    Dim matches As Object

    With re
        .Global = True
        .MultiLine = True
        .IgnoreCase = True
        .pattern = pattern
        If .test(inputString) Then
            Set matches = .Execute(inputString)
            GetString = matches(0).SubMatches(0)
            Exit Function
        End If
    End With
    GetString = "No match"
End Function

1. Я бы использовал Instr для поиска "address":