recuperer une image sur le net

**mikl-dev** · 23/08/2022, 13h30

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!
Nom : Capture.JPG
Affichages : 288
Taille : 136,1 Ko

Nom : Capture.JPG
Affichages : 288
Taille : 136,1 Ko

**jurassic pork** · 23/08/2022, 14h16

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

**mikl-dev** · 23/08/2022, 14h27

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

**jurassic pork** · 24/08/2022, 07h42

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

Nom : RechercheLivre.gif
Affichages : 461
Taille : 71,4 Ko

Ami calmant, J.P

**mikl-dev** · 24/08/2022, 07h46

wahou !!!
Bon j'ai plus qu'a integrer ca.... J'aurais jamais trouver tout seul.
Je te remercie bcp !

**mikl-dev** · 24/08/2022, 08h30

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

j'ai aussi un probleme "objet requis" sur url:
Nom : url.JPG
Affichages : 317
Taille : 35,1 Ko

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

merci encore

**jurassic pork** · 24/08/2022, 08h40

en pièce jointe les fichiers du formulaire
Ne pas oublier de mettre les déclarations d'Api Windows dans un module

**mikl-dev** · 24/08/2022, 14h07

Ç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

**mikl-dev** · 25/08/2022, 07h31

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

merci encore

Envoyé par jurassic pork

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

Ami calmant, J.P

**jurassic pork** · 25/08/2022, 08h52

Hello,

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 :

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

**mikl-dev** · 25/08/2022, 09h03

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?

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

**jurassic pork** · 25/08/2022, 10h47

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

Nom : RechBabelioJP.PNG
Affichages : 265
Taille : 126,7 Ko

Nom : RechBabelioJP2.PNG
Affichages : 272
Taille : 62,0 Ko

recuperer une image sur le net

Macros et VBA Excel

Discussions similaires

Partager

Partager