Recherche sur google à partir d'excel

devi16 Messages postés 65 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
A voir également:

1 réponse

tyranausor Messages postés 4198 Statut Membre 2 040
 
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
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!
0