À l'aide de VBA dans Excel pour la Recherche Google dans IE et retour le lien hypertexte du premier résultat

Je tente d'utiliser IE automatisation de google de recherche une chaîne de texte dans Excel. Je veux revenir le lien hypertexte du site internet du premier résultat dans une autre cellule dans excel. Est-ce possible? J'ai une liste de 60 000 dossiers que j'ai besoin de recherche de google et retour le lien hypertexte du site internet dans les premiers résultats. Est-il une autre approche de ce que tu recommanderais? J'apprécie l'aide à l'avance.

OriginalL'auteur Collin Hendo | 2013-07-05

  1. 18

    Comme ses 60 000 dossiers que je recommande d'utiliser l'objet xmlHTTP au lieu d'utiliser IE.

    Les requêtes HTTP à un plus facile et beaucoup plus rapide

    Télécharger le fichier d'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

    À l'aide de CSS3 Sélecteur de

     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

    À l'aide de VBA dans Excel pour la Recherche Google dans IE et retour le lien hypertexte du premier résultat

    HTH

    Santosh

    Merci! Cela fonctionne bien, sauf après environ 100 enregistrements, j'obtiens une course d'Erreur 80070005 l'Accès est refusé. Des indices sur le pourquoi?
    Nope, il faudra voir de vos données. Alternativement, vous pouvez ajouter un 'on error resume next' sur le haut de code. Si la solution a été utile pls vote.
    Je pourrais vous donner un exemple de mes données. Comment pourrais-je le faire?
    J'ai mis à jour le code. Essayez-le et laissez-moi savoir la réponse. J'ai testé pour environ 140 dossiers qui coulait sans interruption. Alternativement, vous pouvez télécharger le fichier d'exemple de ici
    Super il fonctionne très bien!!! MERCI.....

    OriginalL'auteur Santosh

  2. 0

    Les liens semblent être constamment à l'intérieur de l'intérieur de balises H3. Normalement, vous pouvez utiliser quelque chose comme la façon suivante pour vérifier jusqu'à ce que la page est 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, je voudrais, au lieu de cela, essayez à plusieurs reprises de référence de l'élément à l'intérieur de la première H3 à l'aide de getElementsByTagName("H3"), obtenir le premier de ces éléments, puis regarder à l'intérieur de ce pour la Un lien et ses href attribut.

    En JavaScript, les tentatives de référence inexistante éléments serait de retour undefined mais à partir de VBA, il aura probablement besoin de code de gestion d'erreur.

    Une fois que j'avais obtenu le href je voudrais arrêter la navigation (pas sûr de l'ordre pour cela, probablement ie.Stop) ou passer à la page suivante immédiatement.

    Le premier lien(s), cependant, il est souvent de liens sponsorisés et le href retourné est un peu déformé. Le texte de ces liens sponsorisés apparaissent à inclure em balises. Je pourrais utiliser cette information pour jeter ces liens et de regarder en bas de la page.

    Je ne sais pas si il y a une meilleure façon de le faire.

    OriginalL'auteur Andy G