web-dev-qa-db-fra.com

Utilisation de VBA dans Excel pour la recherche Google dans IE et renvoyer l'hyperlien du premier résultat

J'ai essayé d'utiliser l'automatisation IE pour rechercher dans Google une chaîne de texte dans Excel. Je souhaite renvoyer le lien hypertexte correspondant au site Web du premier résultat dans une autre cellule d'Excel. Est-ce possible? J'ai une liste de 60 000 enregistrements dont j'ai besoin pour effectuer une recherche sur Google et renvoyer l'hyperlien du site Web dans le premier résultat. Existe-t-il une autre approche que vous recommanderiez? J'apprécie l'aide à l'avance. 

excelvbamsxml
9
Collin Hendo

Comme ses 60 000 enregistrements, je recommande d'utiliser l'objet xmlHTTP au lieu d'utiliser IE.
HTTP demande plus facile, et beaucoup plus rapide

Téléchargez le fichier exemple

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
    Dim start_time As Date
    Dim end_time As Date

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

    Dim cookie As String
    Dim result_cookie As String

    start_time = Time
    Debug.Print "start_time:" & start_time

    For i = 2 To lastRow

        url = "https://www.google.co.in/search?q=" & Cells(i, 1) & "&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_time = Time
    Debug.Print "end_time:" & end_time

    Debug.Print "done" & "Time taken : " & DateDiff("n", start_time, end_time) & " :minutes"
    MsgBox "done" & "Time taken : " & DateDiff("n", start_time, end_time)
End Sub

Utilisation du sélecteur CSS3

 Sub XMLHTTP1()

        Dim url As String, i As Long, lastRow As Long
        Dim XMLHTTP As Object, html As New HTMLDocument, objResultDiv As HTMLAnchorElement


        lastRow = Range("A" & Rows.Count).End(xlUp).Row
        For i = 2 To lastRow

            url = "https://www.google.co.in/search?q=" & Cells(i, 1) & "&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 = New HTMLDocument
            html.body.innerHTML = XMLHTTP.ResponseText
            Set objResultDiv = html.querySelector("div#rso h3.r a")

            Cells(i, 2) = objResultDiv.innerText
            Cells(i, 3) = objResultDiv.href

            DoEvents
        Next

    End Sub

Sortie

enter image description here

HTH
Santosh

18
Santosh

Les liens semblent être systématiquement dans les balises H3. Normalement, vous pouvez utiliser quelque chose comme ceci pour vérifier jusqu'à ce que la page soit chargée:

Private Declare Sub Sleep Lib "kernel32" (ByVal nMilliseconds As Long)

Sub UseIE()
    Dim ie As Object
    Dim thePage As Object
    Dim strTextOfPage As String

    Set ie = CreateObject("InternetExplorer.Application")
    'ie.FullScreen = True
    With ie
        '.Visible = True
        .Navigate "http://www.bbc.co.uk"
        While Not .ReadyState = READYSTATE_COMPLETE '4
            Sleep 500      'wait 1/2 sec before trying again
        Wend
    End With

    Set thePage = ie.Document
    'more code here
End Sub

Cependant, j'essaierais à plusieurs reprises de faire référence à l'élément A dans le premier H3 en utilisant getElementsByTagName("H3"), d'obtenir le premier de ces éléments, puis de rechercher dans celui-ci le lien A et son attribut href.

En JavaScript, les tentatives de référence à des éléments inexistants renverraient undefined, mais de VBA, un code de traitement des erreurs sera probablement nécessaire.

Une fois que j'avais obtenu le href j'arrêtais la navigation (pas sûr de la commande pour cela, probablement ie.Stop) ou passais immédiatement à la page suivante.

Les premiers liens seront cependant souvent des liens sponsorisés et le href renvoyé est un peu brouillé. Le texte de ces liens sponsorisés semble inclure des balises em. Je pourrais utiliser ces informations pour supprimer ces liens et regarder plus bas dans la page.

Je ne sais pas s'il existe un meilleur moyen de le faire.

0
Andy G