Public Const url$ = "http://www.cinemapassion.com/jaquettesdvd/"
Sub Recherche_Jaquette(Titre As String)
Dim IE As New InternetExplorer
Dim IEDoc As HTMLDocument
Dim Collection As IHTMLElementCollection
Dim Generic As HTMLGenericElement
Dim Image_Source$, Image_Nom$
'On enregistre l'url complète.
Adresse = url & Titre & ".php"
'Continuer même si erreur.
On Error Resume Next
'Ouvre la page Web.
IE.navigate Adresse
IE.Visible = False
'WaitIE IE
Application.Wait (Now + TimeValue("0:00:02"))
Set IEDoc = IE.document
'On pointe l'élément prix.
'Set Collection = GenericElem.getElementsByClassName("castingreduitbas")
Set Collection = IEDoc.images
'Lien de l'image.
Image_Source = Collection.Item(3).src
Image_Nom = Collection.Item(3).nameProp
Debug.Print Image_Source
'Enregistrement de l'image.
SaveHtmlFile Image_Source, ThisWorkbook.Path & "\" & Image_Nom
'On ferme IE.
IE.Quit
Set IE = Nothing
Set IEDoc = Nothing
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
Do Until IE.readyState = READYSTATE_INTERACTIVE
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
