Recherche sur google à partir d'excel
devi16
Messages postés
65
Statut
Membre
-
tyranausor Messages postés 4198 Statut Membre -
tyranausor Messages postés 4198 Statut Membre -
Bonjour,
Je cherche une macro qui me permet de lancer une recherche sur Google image a partir des cellules de la colonne A.
Si quelqu'un s'est comment téléchargé la première image que google propose pour chaque recher en lui donnant comme titre le texte de la célule associer, sa cerait trop mais alors trop bien.
Merci à vous
voici un bout de code :
'Pilotage d'IE pour récupérer la première photo de Google Images
Dim recherche As String
'Dossier d'enregistrement des pochettes
Dim CheminRep As String
Sub Recuperation_Images()
Dim i As Long
CheminRep = ThisWorkbook.Path & Application.PathSeparator & "Pochette" & Application.PathSeparator
i = 1
Do While Cells(i, 1).Value <> ""
recherche = Cells(i, 1).Value & "+" & Cells(i, 2).Value
Navigation_Internet
i = i + 1
Loop
End Sub
Sub WaitIE(IE As InternetExplorer)
'On boucle tant que la page n'est pas totalement chargée
Do Until IE.ReadyState = READYSTATE_COMPLETE
DoEvents
Loop
End Sub
Sub SaveHtmlFile(aUrl As String, aDestination As String)
'Pris sur le forum de la msdn (avec quelques menues modifs)
'http://social.msdn.microsoft.com/Forums/en/isvvba/thread/bd0ee306-7bb5-4ce4-8341-edd9475f84ad
Dim WinHttpReq As Object, oStream As Object
Dim TheURL As String
On Error Resume Next 'On ne gère pas les erreurs
Set WinHttpReq = CreateObject("Microsoft.XMLHTTP")
WinHttpReq.Open "GET", aUrl, False
WinHttpReq.send
TheURL = WinHttpReq.responseBody
If WinHttpReq.Status = 200 Then
Set oStream = CreateObject("ADODB.Stream")
oStream.Open
oStream.Type = 1
oStream.Write WinHttpReq.responseBody
oStream.SaveToFile aDestination
oStream.Close
End If
End Sub
Sub Navigation_Internet()
Dim IE As New InternetExplorer
Dim IEDoc As HTMLDocument
Dim Generic As HTMLGenericElement
Dim Adresse As String
'Ouvre la page Web
IE.Navigate "www.google.fr/images?q=" & recherche
IE.Visible = False
WaitIE IE
Set IEDoc = IE.document
'On pointe l'élément "reg_s"
On Error Resume Next
Set Generic = IEDoc.all("rg_s")
Set ElementLigne1 = Generic.Children(0).Children(0)
'On établit le premier caractère url de l'image
cDebut = InStr(ElementLigne1, "imgurl") + Len("imgurl") + 1
'La longueur de l'url
cFin = InStr(ElementLigne1, "&imgrefurl") - cDebut
'On en sort l'adresse
Adresse = Mid(ElementLigne1, cDebut, cFin)
'On crée le répertoire où sera téléchargée l'image
On Error Resume Next
MkDir CheminRep
On Error GoTo 0
'On passe le chemin de l'image et le répertoire où elle sera copiée
SaveHtmlFile Adresse, CheminRep & recherche & ".jpg"
Set IE = Nothing
Set IEDoc = Nothing
End Sub
Je cherche une macro qui me permet de lancer une recherche sur Google image a partir des cellules de la colonne A.
Si quelqu'un s'est comment téléchargé la première image que google propose pour chaque recher en lui donnant comme titre le texte de la célule associer, sa cerait trop mais alors trop bien.
Merci à vous
voici un bout de code :
'Pilotage d'IE pour récupérer la première photo de Google Images
Dim recherche As String
'Dossier d'enregistrement des pochettes
Dim CheminRep As String
Sub Recuperation_Images()
Dim i As Long
CheminRep = ThisWorkbook.Path & Application.PathSeparator & "Pochette" & Application.PathSeparator
i = 1
Do While Cells(i, 1).Value <> ""
recherche = Cells(i, 1).Value & "+" & Cells(i, 2).Value
Navigation_Internet
i = i + 1
Loop
End Sub
Sub WaitIE(IE As InternetExplorer)
'On boucle tant que la page n'est pas totalement chargée
Do Until IE.ReadyState = READYSTATE_COMPLETE
DoEvents
Loop
End Sub
Sub SaveHtmlFile(aUrl As String, aDestination As String)
'Pris sur le forum de la msdn (avec quelques menues modifs)
'http://social.msdn.microsoft.com/Forums/en/isvvba/thread/bd0ee306-7bb5-4ce4-8341-edd9475f84ad
Dim WinHttpReq As Object, oStream As Object
Dim TheURL As String
On Error Resume Next 'On ne gère pas les erreurs
Set WinHttpReq = CreateObject("Microsoft.XMLHTTP")
WinHttpReq.Open "GET", aUrl, False
WinHttpReq.send
TheURL = WinHttpReq.responseBody
If WinHttpReq.Status = 200 Then
Set oStream = CreateObject("ADODB.Stream")
oStream.Open
oStream.Type = 1
oStream.Write WinHttpReq.responseBody
oStream.SaveToFile aDestination
oStream.Close
End If
End Sub
Sub Navigation_Internet()
Dim IE As New InternetExplorer
Dim IEDoc As HTMLDocument
Dim Generic As HTMLGenericElement
Dim Adresse As String
'Ouvre la page Web
IE.Navigate "www.google.fr/images?q=" & recherche
IE.Visible = False
WaitIE IE
Set IEDoc = IE.document
'On pointe l'élément "reg_s"
On Error Resume Next
Set Generic = IEDoc.all("rg_s")
Set ElementLigne1 = Generic.Children(0).Children(0)
'On établit le premier caractère url de l'image
cDebut = InStr(ElementLigne1, "imgurl") + Len("imgurl") + 1
'La longueur de l'url
cFin = InStr(ElementLigne1, "&imgrefurl") - cDebut
'On en sort l'adresse
Adresse = Mid(ElementLigne1, cDebut, cFin)
'On crée le répertoire où sera téléchargée l'image
On Error Resume Next
MkDir CheminRep
On Error GoTo 0
'On passe le chemin de l'image et le répertoire où elle sera copiée
SaveHtmlFile Adresse, CheminRep & recherche & ".jpg"
Set IE = Nothing
Set IEDoc = Nothing
End Sub
A voir également:
- Recherche sur google à partir d'excel
- Google maps satellite - Guide
- Google maps - Guide
- Dns google - Guide
- Comment faire une recherche à partir d'une photo - Guide
- Google photo - Télécharger - Albums photo
1 réponse
Bonjour, je ne sais pas si ton code est bon mais en le recopiant et en l'exécutant Excel me pointe une erreur sur la ligne
Si tu as un fichier avec tout ton code, tu peux le poster avec cjoint.com
En attedant, un peu de lecture
Les forumeurs ne sont pas des devins, en tout cas, moi non!
Sub WaitIE(IE As InternetExplorer)!
Si tu as un fichier avec tout ton code, tu peux le poster avec cjoint.com
En attedant, un peu de lecture
Les forumeurs ne sont pas des devins, en tout cas, moi non!