recuperer une image sur le net

Version imprimable

23/08/2022, 13h30
mikl-dev

1 pièce(s) jointe(s)

recuperer une image sur le net

Bonjour, je suis en train de creer un programme pour repertorier tous les lmivres de madame.
J'aimerais qu'en fonction de l'auteur et du nom du livre (ex: Harlan Coben sans un mot), ma USF affiche dans une image la jaquette du livre.
je ne sais pas comment faire ni meme si c'est possible...
dans l'exemple fourni, j'ai telecharger moi meme la jaquette mais je souhaite automatisé cette tache.
merci pour toute l'aide apportée!
Pièce jointe 624226
23/08/2022, 14h16
jurassic pork

hello,
as-tu un ou plusieurs sites où récupérer ces images (ex Babelio) ? Dans quel format (png? jpg?) et quelle taille ?
Ami calmant, J.P
23/08/2022, 14h27
mikl-dev

justement je ne sais pas où aller rechercher ces images.....
En JPG serait tres bien et la taille je m'en fou un peu...

1 pièce(s) jointe(s)

Hello,
voici un exemple de code qui utilise un formulaire constitué de :
- un contrôle Image pour afficher une image de la couverture du livre
- un contrôle Textbox pour saisir le livre à rechercher
- un contrôle Textbox pour afficher l'url de l'image de la couverture du livre et le résumé du livre

Il faut créer un module avec la déclaration d'Api windows dedans :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
#If VBA7 And Win64 Then
    Public Declare PtrSafe Function URLDownloadToFile Lib "urlmon" _
      Alias "URLDownloadToFileA" ( _
        ByVal pCaller As LongPtr, _
        ByVal szURL As String, _
        ByVal szFileName As String, _
        ByVal dwReserved As LongPtr, _
        ByVal lpfnCB As LongPtr _
      ) As Long
 
    Public Declare PtrSafe Sub Sleep Lib "kernel32" _
           (ByVal dwMilliseconds As LongPtr)
#Else
 
 
    Public Declare Function URLDownloadToFile Lib "urlmon" _
      Alias "URLDownloadToFileA" ( _
        ByVal pCaller As Long, _
        ByVal szURL As String, _
        ByVal szFileName As String, _
        ByVal dwReserved As Long, _
        ByVal lpfnCB As Long _
      ) As Long
 
    Public Declare Sub Sleep Lib "kernel32" _
           (ByVal dwMilliseconds As Long)
 
 
#End If

Le principe du code :
On utilise l'objet COM Internet Explorer pour effectuer la recherche.
On lance une recherche par bing du livre sur le site Babelio (par Google il y a des soucis de cookies)
Normalement la première réponse est la page qui nous intéresse ( peut ne pas marcher suivant la saisie du texte de recherche)
On ouvre la page qui correspond à la première réponse.
On vient récupérer le résumé et le lien de l'image de la couverture
On télécharge l'image de la couverture dans un répertoire temporaire et on affiche alors cette image dans le contrôle image.

Le code du formulaire :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
Const RepTemp = "D:\temp\"
Private Sub CmdGo_Click()
Dim IEDoc As Object
Dim objResults As Object, objH2 As Object, elem As Object
Dim livre As Object, image As Object, livreResume As Object
Dim url As String, urlLivre As String, imgName As String
Dim IE As Object
Set IE = CreateObject("InternetExplorer.application")
url = "https://www.bing.com/search?q=" & _
      WorksheetFunction.EncodeURL("Babelio " & _
      Recherche.Text)
IE.Navigate url
IE.Visible = False
   Do While IE.ReadyState <> 4 Or IE.Busy
      DoEvents
      Sleep (100)
   Loop
Set IEDoc = IE.Document
Set objResults = IEDoc.getElementById("b_results")
Set objH2 = objResults.getElementsByTagName("h2")
For Each elem In objH2
    Debug.Print elem.innerText
    If Not elem.getElementsByTagName("a")(0) Is Nothing Then
       Debug.Print elem.getElementsByTagName("a")(0).href
       If InStr(1, elem.getElementsByTagName("a")(0).href, "www.babelio.com/livres") <> 0 Then
          urlLivre = elem.getElementsByTagName("a")(0).href
          Exit For
       End If
    End If
Next
If urlLivre <> "" Then
    Result.Text = urlLivre
    IE.Navigate urlLivre
    Do While IE.ReadyState <> 4 Or IE.Busy
      DoEvents
      Sleep (100)
    Loop
    Set IEDoc = IE.Document
    Set livre = IEDoc.getElementsByClassName("livre_con")(0)
    Set image = livre.getElementsByTagName("img")(0)
    Debug.Print image.src
    Set livreResume = IEDoc.getElementsByClassName("livre_resume")(0)
    Result.Text = image.src + vbCrLf + livreResume.innerText
    ' Recup image
    imgName = Mid(image.src, InStrRev(image.src, "/") + 1)
    URLDownloadToFile 0, image.src, RepTemp & imgName, 0, 0
    Image1.Picture = LoadPicture(RepTemp & imgName)
End If
IE.Quit
End Sub

Pièce jointe 624258

Ami calmant, J.P

24/08/2022, 07h46
mikl-dev

wahou !!!
Bon j'ai plus qu'a integrer ca.... J'aurais jamais trouver tout seul.
Je te remercie bcp !
24/08/2022, 08h30
mikl-dev

1 pièce(s) jointe(s)

J'ai un soucis pour mettre le code là ou il faut...

j'ai aussi un probleme "objet requis" sur url:
Pièce jointe 624260

Est ce que ce serait bcp demander de ma faire un fichier tout pret?? ca devient compliquer a integrer

merci encore
24/08/2022, 08h40
jurassic pork

1 pièce(s) jointe(s)

en pièce jointe les fichiers du formulaire
Ne pas oublier de mettre les déclarations d'Api Windows dans un module
24/08/2022, 14h07
mikl-dev

Ça marche merci beaucoup !!!
mais comment tu as appris à coder comme cela?

et maintenant comment faire pour trouver le nom de l'auteur à coup sûr??
J'ai essayé mais ça marche pour certains mais pas pour d'autres...
merci encore pour ton aide

du coup je cherche aussi comment recuperer le nom de l'auteur et potentiellement aussi le genre (Thriller, etc....)

merci encore

Citation:

Envoyé par jurassic pork

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
#If VBA7 And Win64 Then
    Public Declare PtrSafe Function URLDownloadToFile Lib "urlmon" _
      Alias "URLDownloadToFileA" ( _
        ByVal pCaller As LongPtr, _
        ByVal szURL As String, _
        ByVal szFileName As String, _
        ByVal dwReserved As LongPtr, _
        ByVal lpfnCB As LongPtr _
      ) As Long
 
    Public Declare PtrSafe Sub Sleep Lib "kernel32" _
           (ByVal dwMilliseconds As LongPtr)
#Else
 
 
    Public Declare Function URLDownloadToFile Lib "urlmon" _
      Alias "URLDownloadToFileA" ( _
        ByVal pCaller As Long, _
        ByVal szURL As String, _
        ByVal szFileName As String, _
        ByVal dwReserved As Long, _
        ByVal lpfnCB As Long _
      ) As Long
 
    Public Declare Sub Sleep Lib "kernel32" _
           (ByVal dwMilliseconds As Long)
 
 
#End If

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
Const RepTemp = "D:\temp\"
Private Sub CmdGo_Click()
Dim IEDoc As Object
Dim objResults As Object, objH2 As Object, elem As Object
Dim livre As Object, image As Object, livreResume As Object
Dim url As String, urlLivre As String, imgName As String
Dim IE As Object
Set IE = CreateObject("InternetExplorer.application")
url = "https://www.bing.com/search?q=" & _
      WorksheetFunction.EncodeURL("Babelio " & _
      Recherche.Text)
IE.Navigate url
IE.Visible = False
   Do While IE.ReadyState <> 4 Or IE.Busy
      DoEvents
      Sleep (100)
   Loop
Set IEDoc = IE.Document
Set objResults = IEDoc.getElementById("b_results")
Set objH2 = objResults.getElementsByTagName("h2")
For Each elem In objH2
    Debug.Print elem.innerText
    If Not elem.getElementsByTagName("a")(0) Is Nothing Then
       Debug.Print elem.getElementsByTagName("a")(0).href
       If InStr(1, elem.getElementsByTagName("a")(0).href, "www.babelio.com/livres") <> 0 Then
          urlLivre = elem.getElementsByTagName("a")(0).href
          Exit For
       End If
    End If
Next
If urlLivre <> "" Then
    Result.Text = urlLivre
    IE.Navigate urlLivre
    Do While IE.ReadyState <> 4 Or IE.Busy
      DoEvents
      Sleep (100)
    Loop
    Set IEDoc = IE.Document
    Set livre = IEDoc.getElementsByClassName("livre_con")(0)
    Set image = livre.getElementsByTagName("img")(0)
    Debug.Print image.src
    Set livreResume = IEDoc.getElementsByClassName("livre_resume")(0)
    Result.Text = image.src + vbCrLf + livreResume.innerText
    ' Recup image
    imgName = Mid(image.src, InStrRev(image.src, "/") + 1)
    URLDownloadToFile 0, image.src, RepTemp & imgName, 0, 0
    Image1.Picture = LoadPicture(RepTemp & imgName)
End If
IE.Quit
End Sub

Pièce jointe 624258

Ami calmant, J.P

25/08/2022, 08h52
jurassic pork

Hello,

Citation:

Envoyé par mikl-dev

du coup je cherche aussi comment recuperer le nom de l'auteur et potentiellement aussi le genre (Thriller, etc....)

Pour l'auteur c'est faisable mais pour le genre il n'y a pas forcément l'information. Chez Babelio il y a les étiquettes. Exemple pour le vertige de la peur :

Citation:

suspense thriller thriller psychologique romans policiers et polars intrigant attentats ascenseur meurtre littérature américaine littérature canadienne

Chez Amazon je n'ai pas vu ce genre de renseignement.
Ami calmant, J.P
25/08/2022, 09h03
mikl-dev

ben justement, j'ai su avoir l'auteur de "Sans un mot" mais pas celui du(Le vertige de la peur).
Je me suis apercu que dans les variables, le nom de 'lauteur n'etait pas forcement au meme endroit....enfin pour ce que j'en ai compris.

Tu ferais comment toi?

Citation:

Envoyé par jurassic pork

Hello,

Pour l'auteur c'est faisable mais pour le genre il n'y a pas forcément l'information. Chez Babelio il y a les étiquettes. Exemple pour le vertige de la peur :

Chez Amazon je n'ai pas vu ce genre de renseignement.
Ami calmant, J.P

2 pièce(s) jointe(s)

voici une nouvelle version du code :
1 - qui affiche le lien de l'image de la couverture , le titre exact, l'auteur, les mots clé, le résumé
2 - gère les erreurs pour fermer IE ouvert si il y a une erreur.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
Const RepTemp = "D:\temp\"
Private Sub CmdGo_Click()
Dim IEDoc As Object
Dim objResults As Object, objH2 As Object, elem As Object
Dim livre As Object, image As Object, livreResume As Object
Dim url As String, urlLivre As String, imgName As String, titre As String
Dim title As Object, author As Object, tags As Object
Dim IE As Object
Set IE = CreateObject("InternetExplorer.application")
IE.Visible = False
On Error GoTo ErrProc
url = "https://www.bing.com/search?q=" & _
      WorksheetFunction.EncodeURL("Babelio " & _
      Recherche.Text)
IE.Navigate url
   Do While IE.ReadyState <> 4 Or IE.Busy
      DoEvents
      Sleep (100)
   Loop
Set IEDoc = IE.Document
Set objResults = IEDoc.getElementById("b_results")
Set objH2 = objResults.getElementsByTagName("h2")
For Each elem In objH2
    Debug.Print elem.innerText
    If Not elem.getElementsByTagName("a")(0) Is Nothing Then
       Debug.Print elem.getElementsByTagName("a")(0).href
       If InStr(1, elem.getElementsByTagName("a")(0).href, "www.babelio.com/livres") <> 0 Then
          urlLivre = elem.getElementsByTagName("a")(0).href
          Exit For
       End If
    End If
Next
If urlLivre <> "" Then
    Result.Text = urlLivre
    IE.Navigate urlLivre
    Do While IE.ReadyState <> 4 Or IE.Busy
      DoEvents
      Sleep (100)
    Loop
    Set IEDoc = IE.Document
    Set livre = IEDoc.getElementsByClassName("livre_con")(0)
    Set image = livre.getElementsByTagName("img")(0)
    Result.Text = "Lien image couverture : " + vbCrLf + image.src + vbCrLf
    Debug.Print image.src
    Set title = IEDoc.getElementsByClassName("livre_header_con")(0)
    titre = title.getElementsByTagName("h1")(0).innerText
    Result.Text = Result.Text + "Titre : " + titre + vbCrLf
    Set author = IEDoc.getElementsByClassName("livre_auteurs")(0)
    Result.Text = Result.Text + "Auteur : " + author.innerText + vbCrLf
    Set tags = IEDoc.getElementsByClassName("tags")(0)
    Result.Text = Result.Text + "Mots clé : " + tags.innerText + vbCrLf
    Set livreResume = IEDoc.getElementsByClassName("livre_resume")(0)
    Result.Text = Result.Text + "Résumé : " + livreResume.innerText + vbCrLf
    ' Recup image
    imgName = Mid(image.src, InStrRev(image.src, "/") + 1)
    URLDownloadToFile 0, image.src, RepTemp & imgName, 0, 0
    Image1.Picture = LoadPicture(RepTemp & imgName)
End If
 
 
Leave:
    IE.Quit
    Set IE = Nothing
    On Error GoTo 0
    Exit Sub
 
 
ErrProc:
    MsgBox Err.Description, vbCritical
    Resume Leave
End Sub

Pièce jointe 624332

Pièce jointe 624335