Поиск в Google через VBA ничего не даст, если использовать номер телефона

Question

Используя следующий код, который я нашел в Интернете, он не возвращает результаты при поиске телефонных номеров, с текстом в порядке, возвращает ссылку на веб-сайт и заголовок

Я заметил, что при поиске номера в файле link.className отсутствует className "r", как мне исправить использование телефонных номеров

Sub XMLHTTP()

Dim url As String, lastRow As Long, i As Long
Dim XMLHTTP As Object, html As Object, objResultDiv As Object, objH3 As Object, link As Object

lastRow = Range("A" & Rows.Count).End(xlUp).Row

For i = 2 To lastRow

  url = "https://www.google.co.uk/search?q=03701116565" & "&rnd=" & WorksheetFunction.RandBetween(1, 10000)

    Set XMLHTTP = CreateObject("MSXML2.serverXMLHTTP")
    XMLHTTP.Open "GET", url, False
    XMLHTTP.setRequestHeader "Content-Type", "text/xml"
    XMLHTTP.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.1; rv:25.0) Gecko/20100101 Firefox/25.0"
    XMLHTTP.send

    Set html = CreateObject("htmlfile")
    html.body.innerHTML = XMLHTTP.ResponseText
    Set objResultDiv = html.getelementbyid("rso")

    Set objH3 = objResultDiv.getelementsbytagname("h3")

    For Each link In objH3
        If link.className = "r" Then
            Cells(i, 2) = link.innerText
            Cells(i, 3) = link.getelementsbytagname("a")(0).href
            DoEvents
        End If
    Next
Next

End Sub

Answer 1

Есть имя класса r.Обратите внимание на следующее:

Option Explicit
Public Sub GetLinks()
    Dim html As HTMLDocument, links As Object, i As Long, counter As Long
    Set html = New HTMLDocument
    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", "https://www.google.co.uk/search?q=03701116565", False
        .send
        html.body.innerHTML = StrConv(.responseBody, vbUnicode)
    End With

    With html
        Set links = .querySelectorAll(".r > [href] , .r h3")
    End With
    For i = 0 To links.Length - 1 Step 2
        counter = counter + 1
        ActiveSheet.Cells(counter, 1) = links.item(i)
        ActiveSheet.Cells(counter, 2) = links.item(i + 1).innerText
    Next
End Sub

Фактический href связан с дочерним тегом a, который предшествует элементу тега заголовка h3, на который вы нацеливаетесь по классу.r - это класс родителя тега a.

---

Если вы хотите использовать позднюю границу, иПодобный подход к вашему, вы можете использовать менее эффективный следующий метод.Обратите внимание, что родительские элементы div выбраны, поэтому доступ к тегам a и h3 возможен для соответствующих классов.

Option Explicit
Public Sub GetLinks()
    Dim html As Object, i As Long
    Dim objResultDiv As Object, objH3 As Object, link As Object

    Set html = CreateObject("htmlfile")
    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", "https://www.google.co.uk/search?q=03701116565", False
        .send
        html.body.innerHTML = .responseText
    End With

    Set objResultDiv = html.getElementById("rso")
    Set objH3 = objResultDiv.getElementsByTagName("div")
    For Each link In objH3
        If link.className = "r" Then
            i = i + 1
            On Error Resume Next
            ActiveSheet.Cells(i, 2) = link.getElementsByTagName("a")(0).href
            ActiveSheet.Cells(i, 3) = link.getElementsByTagName("h3")(0).innerText
            On Error GoTo 0
        End If
    Next
End Sub