Предостережения:
Обратите внимание:
- Слишком много запросов или слишком быстро приведет к тому, что сервер предложит вам случайные страницы.
- Я не могу реально протестировать все страницы, поэтому ваш пробег на других страницах может отличаться.
- Есть несколько мест, которые могут быть полезны при добавлении обработки ошибок, но это может быть частью разработки.
tl; dr;
Следующее расширяет и улучшает связанный ответ и код вашего вопроса для обработки нескольких присутствующих чисел.
добавленный код начинается с GetDetails и затем результирующий стек вызовов.Он использует тот же принцип объединения ключей и значений для отображения частей номеров телефонов из инструкций css.
Части ::before для ключей, полученных с помощью регулярного выражения -(\w+):before (см. Выделенные прямоугольники на изображении ниже - 14 совпадений. Класс, отображающий фактические элементы, происходит, например, от .icon-ji, и мытребуется только часть ji для словарного ключа)
Части ::before для значений, полученных с помощью регулярного выражения 9d0(\d+) (см.выделенные прямоугольники на изображении ниже - 13 совпадений)
Последующее вычитание -1 из значений для получения отображаемых цифр на странице.Затем отображение первых 13 в словарь с последующим предоставлением жестко запрограммированной пары 14 значений ключей для последней группы захвата ключей
decodeDict(keys(UBound(keys))) = "+"
Чтобы определить, сколько телефонных номеров действительно присутствует, мы извлекаемhtml для телефонного контакта:
htmlToSearch = html.querySelector(".telCntct").outerHTML
А затем используйте регулярное выражение для сопоставления либо с первым значением мультикласса каждого дочернего диапазона, либо с символом ",".Это так, мы знаем, где нам нужно разделить декодированную строку, чтобы получить требуемые выходные числа.
Обратите внимание, что в этом случае будет 24 совпадения, один из которых будет "," между контактными номерами, видимыми на странице:
Мы предполагаем, что "," это разделитель между номерами телефонов и тем, что number of tel numbers listed = count of "," + 1.
Оглядываясь на html для контакта по телефонумы можем видеть, что "," находится за пределами дочерних диапазонов, поэтому не был бы возвращен из querySelector/querySelectorAll в parent (с родительским html, помещенным в другой HTMLDocument, чтобы использовать эти методы);Более того, любая попытка использовать синтаксис next , например, nextSibling, не сохранит требуемый порядок вывода.
output имеет нашу декодированную строку, готовую к разбиению на части, например
25 символов длиной, состоящих из двух чисел.
Значения массива groups указывают нам, где разбить эту строку, как мы знаем всякий раз, когда мы находим ", "следующий символ - начало нового числа.
Итак, мы зациклируем массив groups и проверим значение в каждой позиции, используемположение каждого "," в группах для определения разбиения строки на выходной массив телефонных номеров:
Dim totalNumbers As Long, count As Long, results()
totalNumbers = UBound(Split(htmlToSearch, ","))
ReDim results(0 To totalNumbers)
For i = LBound(groups) To UBound(groups)
If InStr(groups(i), ",") > 0 Then
results(count) = Mid$(output, startPos, IIf(startPos = 1, i, i - startPos))
startPos = i + 1
count = count + 1
End If
Next
results(totalNumbers) = Right$(output, Len(output) - startPos - 1)
GetNumbers = results
Выход:
VBA:
Option Explicit
Public Sub GetTelNumbers()
Dim html As htmlDocument, url As String, re As Object, s As String
Set re = CreateObject("vbscript.regexp")
url = "https://www.justdial.com/chengalpattu/Oasis-Pharma-Near-Saraswathi-Children-School-Revathypuram-Urapakkam/9999PXX44-XX44-181123145524-X8G7_BZDET"
With CreateObject("MSXML2.XMLHTTP")
.Open "GET", url, False
.send
s = .responsetext
End With
Set re = CreateObject("vbscript.regexp")
Set html = New htmlDocument
html.body.innerHTML = s
With ThisWorkbook.Worksheets("Sheet1").Range("A2")
.Offset(0, 0) = url
.Offset(0, 1) = html.querySelector(".fn").innerText
.Offset(0, 2) = Split(Split(Trim$(Replace$(GetString(re, s, "title>(.*)<"), Chr$(34), vbNullString)), "- ")(1), " -")
.Offset(0, 3) = Trim$(Replace$(GetString(re, s, "streetAddress"":(.*"")"), Chr$(34), vbNullString))
.Offset(0, 4) = Trim$(Replace$(GetString(re, s, "addressLocality"":(.*"")"), Chr$(34), vbNullString))
.Offset(0, 5) = Trim$(Replace$(GetString(re, s, "postalCode"":(.*"")"), Chr$(34), vbNullString))
.Offset(0, 6) = Trim$(Replace$(GetString(re, s, "addressRegion"":(.*"")"), Chr$(34), vbNullString))
.Offset(0, 7) = Trim$(Replace$(GetString(re, s, "addressCountry"":(.*"")"), Chr$(34), vbNullString))
Dim numbers()
numbers = GetDetails(re, s)
.Offset(0, 8).Resize(1, UBound(numbers) + 1) = numbers
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
Public Function GetDetails(ByVal re As Object, ByVal responsetext As String) As Variant
Dim decodeDict As Object, i As Long
Dim html As MSHTML.htmlDocument, keys(), values()
Set decodeDict = CreateObject("Scripting.Dictionary")
Set html = New MSHTML.htmlDocument
html.body.innerHTML = responsetext
keys = GetMatches(re, responsetext, "-(\w+):before")
If UBound(keys) = 0 Then Exit Function
values = GetMatches(re, responsetext, "9d0(\d+)", True)
For i = LBound(values) To UBound(values)
decodeDict(keys(i)) = values(i)
Next
Dim itemsToDecode()
decodeDict(keys(UBound(keys))) = "+"
itemsToDecode = GetValuesToDecode(html)
GetDetails = GetNumbers(re, html, itemsToDecode, decodeDict)
End Function
Public Function GetMatches(ByVal re As Object, ByVal inputString As String, ByVal sPattern As String, Optional ByVal numeric = False, Optional ByVal spanSearch = False) As Variant
Dim matches As Object, iMatch As Object, s As String, arrMatches(), i As Long
With re
.Global = True
.MultiLine = True
.IgnoreCase = True
.pattern = sPattern
If .Test(inputString) Then
Set matches = .Execute(inputString)
ReDim arrMatches(0 To matches.count - 1)
For Each iMatch In matches
If numeric Then
arrMatches(i) = iMatch.SubMatches.item(0) - 1
Else
If spanSearch Then
arrMatches(i) = iMatch
Else
arrMatches(i) = iMatch.SubMatches.item(0)
End If
End If
i = i + 1
Next iMatch
Else
ReDim arrMatches(0)
arrMatches(0) = vbNullString
End If
End With
GetMatches = arrMatches
End Function
Public Function GetValuesToDecode(ByVal html As MSHTML.htmlDocument) As Variant
Dim i As Long, elements As Object, results(), class As String
Set elements = html.querySelectorAll(".telCntct span[class*='icon']")
ReDim results(elements.Length - 1)
For i = 0 To elements.Length - 1
class = elements.item(i).className
results(i) = Right$(class, Len(class) - InStrRev(class, "-"))
Next
GetValuesToDecode = results
End Function
Public Function GetNumbers(ByVal re As Object, ByVal html As htmlDocument, ByVal itemsToDecode As Variant, ByVal decodeDict As Object) As Variant
Dim output As String, i As Long
For i = LBound(itemsToDecode) To UBound(itemsToDecode)
output = output & decodeDict(itemsToDecode(i))
Next
Dim htmlToSearch As String, groups As Variant, startPos As Long, oldStartPos As Long
htmlToSearch = html.querySelector(".telCntct").outerHTML
groups = GetMatches(re, htmlToSearch, "mobilesv|,", False, True)
startPos = 1
Dim totalNumbers As Long, count As Long, results()
totalNumbers = UBound(Split(htmlToSearch, ","))
ReDim results(0 To totalNumbers)
For i = LBound(groups) To UBound(groups)
If InStr(groups(i), ",") > 0 Then
results(count) = "'" & Mid$(output, startPos, IIf(startPos = 1, i, i - startPos)) 'to preserve any leading zeroes
startPos = i + 1
count = count + 1
End If
Next
results(totalNumbers) = Right$(output, Len(output) - startPos - 1)
GetNumbers = results
End Function