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