Automatiquement chercher le nombre de résultats sur google

Bonjour :

J'ai une colonne de mots-clés. Quand je clique sur un mot, je voudrais recevoir une boîte de dialogue en affichant le nombre de résultats de ce mot-clé sur google.

Par exemple :

Dans la case A2, c'est "bmw i8". Quand je clique dessus, il va me renvoyer "13,300,000", ce qui est le nombre de résultats affiché en haut de la page si vous cherchez "bmw i8" sur google.

Normalement j'aurais écrit un code de base, mais cette fois-ci je n'ai aucune idée jusqu'au présent.

Merci d'avance.

J'ai trouvé un code :

Public Sub ExcelGoogleSearch()

Dim searchWords As String

With Sheets("Sheet1")
RowCount = 1
Do While .Range("A" & RowCount) <> ""
searchWords = .Range("A" & RowCount).Value

' Get keywords and validate by adding + for spaces between
searchWords = Replace$(searchWords, " ", "+")

' Obtain the source code for the Google-searchterm webpage
search_url = "http://www.google.com/search?hl=en&q=""" & searchWords & """&meta="""
Set search_http = CreateObject("MSXML2.XMLHTTP")
search_http.Open "GET", search_url, False
search_http.send
results_var = search_http.responsetext
Set search_http = Nothing

' Find the number of results and post to sheet
pos_1 = InStr(1, results_var, "resultStats>", vbTextCompare)

If pos_1 = 0 Then
  NumberofResults = 0
Else
  pos_2 = InStr(3 + pos_1, results_var, ">", vbTextCompare)
  pos_3 = InStr(pos_2, results_var, "<nobr>", vbTextCompare)
  NumberofResults = Mid(results_var, 1 + pos_2, (-1 + pos_3 - pos_2))
End If

Range("B" & RowCount) = NumberofResults
RowCount = RowCount + 1
Loop
End With
End Sub

Mais j'ai eu une erreur "Accès refusé" à la ligne :

search_http.Send

Bonjour :

J'ai étudié le code. Il y a plusieurs partie à adapter, y compris l'url et le nom de sheets.

On peut tester avec une petite partie du code. S'il fonctionne, le code intégral va fonctionner. (non pas besoin d'écrire dans "feuill1")

Public Sub ExcelGooglePHRASESearch()
    Dim search_http As Object
    Dim results_var As String
    Dim search_url As String
    With Sheets("Feuil1")
    search_url = "https://www.google.fr/#q=abc"   ' Chercher "abc" sur google
            Set search_http = CreateObject("MSXML2.XMLHTTP")
            'InputBox "URL:", "URL", search_url
            search_http.Open "GET", search_url, False
            search_http.Send
            results_var = CStr(search_http.responsetext)
            MsgBox results_var
    End With
End sub

Il me renvoie cela :

Le problème est que dans ce texte, parmi tous les nombres mal rangés, il n'y a pas le nombre de résultats de "abc".

Solution trouvée :

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Dim ligneCount As Long
    ligneCount = Range("B" & Rows.Count).End(xlUp).Row
    If Target.Column = 2 And Target.Row > 4 And Target.Row <= ligneCount Then
        ExcelGooglePHRASESearch ActiveCell.Value
    End If
End Sub

Function ExcelGooglePHRASESearch(valeur)
    Dim search_http As Object
    Dim results_var As String
    Dim search_url As String
    With Sheets("Données générales")

       search_url = "https://www.google.fr/search?sclient=psy-ab&hl=fr&site=webhp&source=hp&q=" & valeur

        Set search_http = CreateObject("microsoft.xmlhttp")
        'InputBox "URL:", "URL", search_url
        With search_http
            .Open "get", search_url, False
' tres souvent on est obligé de faire l'entete de la requete mais dans ce cas present non alors j'ai bloquer les lignes mais c'est juste pour information
           ' .SetRequestHeader "Accept", " text/html, application/xhtml+xml, */*"
           ' .SetRequestHeader "Accept-Language", "fr-FR"
           ' .SetRequestHeader "User-Agent", " Mozilla/5.0 (compatible; MSIE 10.0; Windows NT 6.1; WOW64; Trident/6.0)"
           ' .SetRequestHeader "Accept-E ncoding", "gzip, deflate"
           ' .SetRequestHeader "Host", "www.google.fr"
           ' .SetRequestHeader "DNT", 1
           ' .SetRequestHeader "Connection", "Keep - Alive"
            search_http.Send
            results_var = CStr(search_http.responsetext)
        End With
    End With
'on place le code html de la requete dans un document html virtuel
'
With CreateObject("htmlfile")
.write results_var
MsgBox .getelementbyid("resultStats").innertext
'dans ce bloc with tu peut disséquer ta page comme si c'etait IE et récupérer tout les titre des proposition par exemple
End With
End Function