Соскоб с использованием VBA

Question

Я хотел бы извлечь данные из этого URL .

Я хочу извлечь Название, номер мобильного контакта и адрес из каждой из 10 визитных карточек.

Вот код, который я пробовал, но не добился успеха.

Public Sub GetValueFromBrowser()
    On Error Resume Next
    Dim Sn As Integer
    Dim ie As Object
    Dim url As String
    Dim Doc As HTMLDocument
    Dim element As IHTMLElement
    Dim elements As IHTMLElementCollection

    For Sn = 1 To 1

        url = Sheets("Infos").Range("C" & Sn).Value

        Set ie = CreateObject("InternetExplorer.Application")

        With ie
            .Visible = 0
            .navigate url
            While .Busy Or .readyState <> 4
                DoEvents
            Wend
        End With    

        Set Doc = ie.document
        Set elements = Doc.getElementsByClassName(" col-sm-5 col-xs-8 store-details sp-detail paddingR0")

        Dim count As Long
        Dim erow As Long
        count = 0
        For Each element In elements
            If element.className = "lng_cont_name" Then
                erow = Sheet1.Cells(Rows.count, 1).End(xlUp).Offset(1, 0).Row
                Cells(erow, 1) = Doc.getElementsByClassName("Store-Name")(count).innerText
                Cells(erow, 2) = Doc.getElementsByClassName("cont_fl_addr")(count).innerText
                count = count + 1
            End If
        Next element

        If Val(Left(Sn, 2)) = 99 Then
            ActiveWorkbook.Save
        End If

    Next Sn
End Sub

Answer 1

Телефонные номера были непростыми, так как я думаю, что их специально сделали трудными для чистки.Я нашел способ расшифровать значения из содержимого элемента CSS pseudo :: before.Адреса и названия были простым выбором CSS.

---

С тех пор я написал более понятный скрипт на python здесь .

---

Итак, какработают различные части кода?

title:

Set titles = .querySelectorAll(".jcn [title]")

Я нацеливаю заголовки как элементы, которые имеют атрибут title сродительский jcn атрибут класса."." обозначает селектор класса, "[]" селектор атрибута, а " " между ними - комбинатор-потомок.

querySelectorAll метод document возвращает nodeList всех соответствующих элементов на странице, то есть 10 заголовков.

---

адреса:

Set addresses = .querySelectorAll(".desk-add.jaddt")

Для адресов указывается атрибут класса desk-add jaddt.Так как имена составных классов недопустимы, дополнительный "." должен заменить пробел в имени.

---

Телефонные номера (через расшифровку содержимого в пределах storesTextToDecipher):

Set storesTextToDecipher = .querySelectorAll(".col-sm-5.col-xs-8.store-details.sp-detail.paddingR0")

Вот где происходит магия.Числа не доступны через DOM напрямую, поскольку они являются содержимым псевдоэлемента.

Если вы изучите соответствующий HTML, вы обнаружите серию псевдо :: before элементов .VBA не предоставляет механизма применения псевдоселекторов, чтобы попытаться получить эту информацию в CSS для страницы.

То, что вы видите, на самом деле представляет собой серию элементов span, каждый из которыхиметь атрибут класса, начинающийся с mobilesv.Эти элементы находятся в пределах одного родительского элемента класса col-sm-5 col-xs-8 store-details sp-detail paddingR0 (обратите внимание, снова составное имя класса).

Я первоначально собираю nodeList всех родительских элементов.

Пример возвращаемых элементов:

Каждый из этих родительских элементов содержит элементы имени класса (начиная с mobilesv), которые составляют символы телефоначисловая строкаНекоторые символы являются числами в строке, другие представляют +()-.Примечание: 2 | 3 буквенные строки в именах классов после icon- например dc, fe.

Например, первый результат поиска на странице, для начального числа 9 в телефонном номере:

Фактическое содержание CSS для этого псевдоэлемента / телефонного символа можно наблюдать в стиле CSS:

Обратите внимание на имя класса и перед селектором псевдоэлемента: .icon-ji:before И содержание \9d010.

Короче говоря ...Вы можете извлечь 2 или 3 буквы после icon-, то есть ji в этом случае, и числовую строку после \9d0, то есть 10 в этом случае, и использовать эти два бита информации для расшифровки телефонного номера.,Эта информация доступна в ответе:

См. Те же 2/3 буквенные строки, которые связаны с именами классов телефонной строки слева, и инструкции по содержаниюсправа.Небольшая математика выводит, что число справа на 1 больше номера телефона для этого класса, показанного на изображении веб-страницы.Я просто создаю словарь, который затем сопоставляет 2/3 буквенную аббревиатуру с номером телефона, анализируя этот раздел HTML.

При циклическом переходе по storesTextToDecipher я использую этот словарь для расшифровки действительного телефонного номера изсоответствующее 2/3 буквенное сокращение в имени класса.

---

VBA:

Option Explicit
Public Sub GetInfo()
    Dim sResponse As String, html As HTMLDocument
    Set html = New HTMLDocument
    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", "https://www.justdial.com/Ahmedabad/Beauty-Parlours/page-3", False
        .setRequestHeader "If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT"
        .send
        sResponse = StrConv(.responseBody, vbUnicode)
    End With

    Dim cipherKey As String, cipherDict As Object
    Set cipherDict = CreateObject("Scripting.Dictionary")
    cipherKey = Split(Split(sResponse, "smoothing:grayscale}.icon-")(1), ".mobilesv")(0)
    cipherKey = Replace$(cipherKey, ":before{content:""\9d", Chr$(32))

    Dim arr() As String, tempArr() As String, i As Long, j As Long
    arr = Split(cipherKey, """}.icon-")
    For i = LBound(arr) To UBound(arr)
        tempArr = Split(arr(i), Chr$(32))
        cipherDict(tempArr(0)) = Replace$(tempArr(1), """}", vbNullString) - 1 'needs adjustment
    Next

    html.body.innerHTML = sResponse
    Dim titles As Object, addresses As Object, storesTextToDecipher As Object
    With html
        Set titles = .querySelectorAll(".jcn [title]")
        Set addresses = .querySelectorAll(".desk-add.jaddt")
        Set storesTextToDecipher = .querySelectorAll(".col-sm-5.col-xs-8.store-details.sp-detail.paddingR0")
    End With

    For i = 0 To titles.Length - 1
        Debug.Print "title: " & titles.item(i).innerText
        Debug.Print "address: " & addresses.item(i).innerText
        Debug.Print GetStoreNumber(storesTextToDecipher.item(i), cipherDict)
    Next
End Sub
Public Function GetStoreNumber(ByVal storeInfo As Object, cipherDict As Object) As String
    Dim html2 As HTMLDocument, elems As Object, telNumber As String, j As Long
    Set html2 = New HTMLDocument
    html2.body.innerHTML = storeInfo.innerHTML
    Set elems = html2.querySelectorAll("b span")
    For j = 0 To elems.Length - 1
        On Error Resume Next
        If cipherDict(Replace$(elems.item(j).className, "mobilesv icon-", vbNullString)) < 10 Then
            telNumber = telNumber & cipherDict(Replace$(elems.item(j).className, "mobilesv icon-", vbNullString))
        End If
        On Error GoTo 0
    Next
   GetStoreNumber = telNumber
End Function

---

Пример вывода:

---

Редактировать: Все результаты страницы

Поскольку теперь вам нужно больше 10, следующее использует ожидаемое количество результатов страницы (NUMBER_RESULTS_ON_PAGE) для сбора информации со страницы. Она прокручивает страницу до тех пор, пока не будет найдено ожидаемое количество телефонных номеров (которые должны быть уникальными),или MAX_WAIT_SEC. Это означает, что вы избегаете бесконечного цикла и можете установить ожидаемое количество результатов, если ожидаете другое число. Это зависит от того, в каком магазине указан телефонный номер - это довольно разумное предположение.

Option Explicit
Public Sub GetInfo()
    Dim IE As New InternetExplorer, resultCountDict As Object, cipherDict As Object, t As Date
    Const MAX_WAIT_SEC As Long = 300 'wait 5 minutes max before exiting loop to get all results
    Const NUMBER_RESULTS_ON_PAGE As Long = 80
    Const URL = "https://www.justdial.com/Ahmedabad/Beauty-Parlours/page-3"

    Dim titles As Object, addresses As Object, storesTextToDecipher As Object

    Application.ScreenUpdating = True

    Set resultCountDict = CreateObject("Scripting.Dictionary")
    Set cipherDict = GetCipherDict(URL)

    With IE
        .Visible = True
        .Navigate2 URL

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

        With .document
            t = Timer
            Do
                DoEvents
                Set titles = .querySelectorAll(".jcn [title]")
                Set addresses = .querySelectorAll(".desk-add.jaddt")
                Set storesTextToDecipher = .querySelectorAll(".col-sm-5.col-xs-8.store-details.sp-detail.paddingR0")
                Dim telNumber As String, i As Long

                For i = 0 To titles.Length - 1
                    telNumber = GetStoreNumber(storesTextToDecipher.item(i), cipherDict)
                    If Not resultCountDict.Exists(telNumber) Then
                        resultCountDict.Add telNumber, Array(titles.item(i).innerText, addresses.item(i).innerText, telNumber)
                    End If
                Next

                .parentWindow.execScript "window.scrollBy(0, window.innerHeight);", "javascript"

                While IE.Busy Or IE.readyState < 4: DoEvents: Wend
                If Timer - t > MAX_WAIT_SEC Then Exit Do
            Loop Until resultCountDict.Count = NUMBER_RESULTS_ON_PAGE

        End With
        .Quit
    End With

    Dim key As Variant, rowCounter As Long
    rowCounter = 1
    With ThisWorkbook.Worksheets("Sheet1")
        For Each key In resultCountDict.keys
            .Cells(rowCounter, 1).Resize(1, 3) = resultCountDict(key)
            rowCounter = rowCounter + 1
        Next
    End With
    Application.ScreenUpdating = True
End Sub

Public Function GetStoreNumber(ByVal storeInfo As Object, cipherDict As Object) As String
    Dim html2 As HTMLDocument, elems As Object, telNumber As String, j As Long
    Set html2 = New HTMLDocument
    html2.body.innerHTML = storeInfo.innerHTML
    Set elems = html2.querySelectorAll("b span")
    For j = 0 To elems.Length - 1
        On Error Resume Next
        If cipherDict(Replace$(elems.item(j).className, "mobilesv icon-", vbNullString)) < 10 Then
            telNumber = telNumber & cipherDict(Replace$(elems.item(j).className, "mobilesv icon-", vbNullString))
        End If
        On Error GoTo 0
    Next
   GetStoreNumber = telNumber
End Function

Public Function GetCipherDict(ByVal URL As String) As Object
    Dim sResponse As String, html As HTMLDocument
    Set html = New HTMLDocument
    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

    Dim cipherKey As String, cipherDict As Object
    Set cipherDict = CreateObject("Scripting.Dictionary")
    cipherKey = Split(Split(sResponse, "smoothing:grayscale}.icon-")(1), ".mobilesv")(0)
    cipherKey = Replace$(cipherKey, ":before{content:""\9d", Chr$(32))

    Dim arr() As String, tempArr() As String, i As Long, j As Long
    arr = Split(cipherKey, """}.icon-")
    For i = LBound(arr) To UBound(arr)
        tempArr = Split(arr(i), Chr$(32))
        cipherDict(tempArr(0)) = Replace$(tempArr(1), """}", vbNullString) - 1 'needs adjustment
    Next
    Set GetCipherDict = cipherDict
End Function