Problème - variable IE - récupérer le contenu d'une page web

Version imprimable

Voir 40 message(s) de cette discussion en une page

Salut

Citation:

En comparant avec une autre référence de colis, s'il y a correspondance des images,
dans ce cas ce ne serait pas difficile de convertir une image en texte …

Marc-L, peux tu développer ton idée, je ne comprend pas.
Je peux me tromper, mais je pense que tu sous-estimes le problème.

mgelec
Concernant le téléchargement des images, la collection de TD pointe chaque cellule, il est parfois préférable de pointer les lignes du tableau, ici en l’occurrence, seule la ligne 1 t'intéresse pour avoir le dernier état connu de ton colis si j'ai bien compris.

Si je devais faire un code pour cette page web, je pointerais le 1er élément placé en amont du tableau et ayant un nom ou un id, dans notre cas ce serait

Code:

<div id="resultatSuivreDiv">

ensuite il suffit de regarder la filiation jusqu'au tableau, ici

Code:

Set ElementLigne1 = ElementresultatSuivreDiv.children(1).children(2).children(0)

Avec ça, ElementLigne1 pointe sur la 1ère ligne de ton tableau, les différentes cellules du tableau sont contenues dans la collection ElementLigne1.children.
Par exemple pour la date

Code:

Set ElementImage = ElementLigne1.children(0).children(0)

Ensuite pour télécharger l'image, il suffit d'avoir sont adresse, si tu regarde dans le code source tu as quelques choses comme

Code:

<img src="imageio?styleBold=true&width=75&id=fr_23867263_date_1">

La partie qui nous interesse est "imageio?styleBold=true&width=75&id=fr_23867263_date_1", c'est une adresse relative au domaine, c'est à dire que la vraie adresse de l'image est

Code:

http://www.colissimo.fr/portail_colissimo/imageio?styleBold=true&width=75&id=fr_23867263_date_1

cette adresse complète est contenue dans la propriété href de l'image.

Voila un morceau de code... sauf que ça ne fonctionne pas, car l'image visiblement est créée à la volée par le serveur au moment de l'appel et que son téléchargement via le lien renvoie une image vide. Il faudra donc trouver une autre solution...

Le code complet:
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 Option Explicit Sub Colissiomo() 'Lancer la recherche par le bouton Dim IE As New InternetExplorer Dim IEDoc As HTMLDocument Dim Generic As HTMLGenericElement Dim ElementResultatSD As HTMLDivElement Dim ElementLigne1 As HTMLTableRow Dim ElementImgDate1 As HTMLImg 'Ouvre la page WEB IE.navigate "http://www.colissimo.fr/portail_colissimo/suivre.do?m=10003005&colispart=8J00238672635" IE.Visible = True WaitIE IE Set IEDoc = IE.document 'On pointe le 1er élément avec un id Set ElementResultatSD = IEDoc.getElementById("resultatSuivreDiv") 'On pointe la 1ère ligne du tableau Set ElementLigne1 = ElementResultatSD.Children(1).Children(2).Children(0) 'On pointe l'image date Set ElementImgDate1 = ElementLigne1.Children(0).Children(0) 'On telecharge l'image SaveHtmlFile ElementImgDate1.href, "e:\teste.png" Set IE = Nothing Set IEDoc = Nothing End Sub Sub WaitIE(IE As InternetExplorer) '¤4A¤ '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) 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
[Edit]
J'ai testé en faisant des requêtes serveur sur l'image, avec identifiant et tout et tout... mais ça ne semble pas fonctionner, l'image retournée est vide également.

Une autre piste serait de récupérer l'image contenue dans le cache...

[/Edit]

++
Qwaz

Bonsoir,
Un essai sur une image juste pour voir (image téléchargée dans un dossier nommé "téléchargement" lui-même créé sur le bureau) :

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
72
73
74
75
76
77
78
79
80
81
82
Option Explicit
 
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
 
 
Const strURL As String = "http://www.colissimo.fr/portail_colissimo/suivre.do?m=10003005&colispart=8J00238672635" 'URL du site
Const strFileURL As String = "http://www.colissimo.fr/portail_colissimo/" 'préfixe de l'URL des images
 
 
Sub XmlHttpRequest_Api()
Dim oXmlHttp As XMLHTTP
Dim HtmlFile As Object
Dim oStream As Object
Dim HtmlDoc As String
Dim strPathName As String
Dim strPathFileName As String
Dim ElementResultatSD As HTMLDivElement
Dim ElementLigne1 As HTMLTableRow
Dim ElementImgDate1 As HTMLImg
 
 
Set oXmlHttp = CreateObject("Microsoft.XMLHTTP")
 
 
oXmlHttp.Open "GET", strURL, False
oXmlHttp.send
 
 
If oXmlHttp.Status = 200 Then HtmlDoc = oXmlHttp.responseText
 
 
If HtmlDoc <> vbNullString Then
  strPathName = GetDesktopFolder & "\" & "téléchargement" & "\" 'chemin du dossier contenant les fichiers
  On Error Resume Next
  MkDir strPathName 'si le dossier n'existe pas on le crée
  On Error GoTo 0 'On réactive la gestion d'erreur au cas une une erreur a été levée
 
  'on crée un document HTML dans lequel on va recopier la structure HTML de l'URL
  '(contenue sous forme de texte dans la variable HtmlDoc) afin de pointer vers les liens contenus dans la page
  Set HtmlFile = CreateObject("HTMLFile")
  HtmlFile.Write HtmlDoc
 
  Set oStream = CreateObject("ADODB.Stream")
  oStream.Open
  oStream.WriteText HtmlDoc
  oStream.Close
 
  'base de travail de Qwazerty
  'On pointe le 1er élément avec un id
  Set ElementResultatSD = HtmlFile.getElementById("resultatSuivreDiv")
 
 
  'On pointe la 1ère ligne du tableau
  Set ElementLigne1 = ElementResultatSD.Children(1).Children(2).Children(0)
 
 
  'On pointe l'image date
  Set ElementImgDate1 = ElementLigne1.Children(0).Children(0)
 
  strPathFileName = strFileURL & Replace(ElementImgDate1.href, "about:", vbNullString)
 
 
  URLDownloadToFile 0, strPathFileName, strPathName & "test.png", 0, 0
 
  Set oXmlHttp = Nothing
  Set oStream = Nothing
  Set HtmlFile = Nothing
  Set ElementResultatSD = Nothing
  Set ElementLigne1 = Nothing
  Set ElementImgDate1 = Nothing
 
End If
End Sub
 
 
Function GetDesktopFolder()
Dim oShell As Object
  Set oShell = CreateObject("WScript.Shell")
  GetDesktopFolder = oShell.SpecialFolders("Desktop")
End Function

Ceci dit je ne vois pas réellement l'intérêt de récupérer des images si les données qu'elles contiennent ne sont pas exploitables sur Excel...à voir.

A+

09/01/2015, 00h27
Qwazerty

Salut

Merci! Ben mince, cet api à l'aire de mieux fonctionné que la procédure que j'utilisais plus haut, faudra que je teste ça :D
Je ne sais pas si l'image récupérée servira mais toujours j'ai appris quelque chose et rien que pour ça, je suis content d'avoir participé ;)

++
Qwaz
09/01/2015, 07h20
davido84

Bonjour Qwazerty,
teste à nouveau ton code ce matin pour voir...
A+

Salut

En effet j'ai trouvé mon erreur, je passais des paramètres au moment du Send, alors qu'ils étaient déjà présent dans l'adresse que je fournissais à la requêtes...:aie: Bref, par orgueil je place mon code qui marche! :D

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
Sub Colissiomo()
'Lancer la recherche par le bouton
Dim IE As New InternetExplorer
Dim IEDoc As HTMLDocument
Dim Generic As HTMLGenericElement
Dim ElementResultatSD As HTMLDivElement
Dim ElementLigne1 As HTMLTableRow
Dim ElementImgDate1 As HTMLImg
Dim URL As String
 
Dim DemandeFichier As New MSXML2.XMLHTTP 'activer Microsoft XML dans les références
Dim URLImg As String
Dim StreamFile As New ADODB.Stream 'activer M$ ActiveX Data Object Lib
 
 
    'Ouvre la page WEB
    URL = "http://www.colissimo.fr/portail_colissimo/suivre.do?m=10003005&colispart=8J00238672635"
    IE.Visible = True
    IE.navigate URL
    WaitIE IE
    Set IEDoc = IE.document
 
    'On pointe le 1er élément avec un id
    Set ElementResultatSD = IEDoc.getElementById("resultatSuivreDiv")
 
    'On pointe la 1ère ligne du tableau
    Set ElementLigne1 = ElementResultatSD.Children(1).Children(2).Children(0)
 
    'On pointe l'image date
    Set ElementImgDate1 = ElementLigne1.Children(0).Children(0)
 
    'On telecharge l'image
    'SaveHtmlFile ElementImgDate1.href, "e:\teste.png"
 
 
    URLImg = ElementImgDate1.href
 
    'On génère la requête
    With DemandeFichier
        .Open "GET", URLImg, False
        .setRequestHeader "Accept", "image/png, image/svg+xml, image/*;q=0.8, */*;q=0.5"
        .setRequestHeader "Accept-Encoding", "gzip , deflate"
        '.setRequestHeader "Content-Type", "application/x-www-form-urlencoded; charset=UTF-8"  'Ajouté
        .setRequestHeader "Cache-Control", "max-age=0"  'Ajouté
        .setRequestHeader "Accept-Language", "fr,fr-fr;q=0.8,en-us;q=0.5,en;q=0.3"
        .setRequestHeader "Connection", "keep-alive" 'Modifié, espace retiré "keep -alive"
        .setRequestHeader "Host", "www.colissimo.fr"
        .setRequestHeader "Referer", URL
        .setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.0; rv:29.0) Gecko/20100101 Firefox/29.0"
        .setRequestHeader "Cookies", IEDoc.cookie
 
 
        'On l'exécute la requête
        'http://www.colissimo.fr/portail_colissimo/imageio?styleBold=true&width=260&id=fr_23867263_libe_1
        .send '"styleBold=true&width=75&id=fr_23867263_date_1" 'les paramètres sont déjà inclus dans URLImg...
 
        'On copie les données dans un fichier
        StreamFile.Type = 1                              'binary
        StreamFile.Open
        StreamFile.write .responseBody
        StreamFile.SaveToFile "E:\Data.png", 2                'overwrite
        StreamFile.Close
    End With
 
    Set IE = Nothing
    Set IEDoc = Nothing
End Sub

MgElec, peux-tu faire passer plusieurs liens vers des colis différents, histoire d'avoir un panel le plus exhaustif possible des différents messages sur lesquels on peut tomber, je pense surtout aux "libellés", pour la localisation et les date ça sera plus compliqué/différent.

++
Qwaz

09/01/2015, 07h45
davido84

Citation:

En effet j'ai trouvé mon erreur, je passais des paramètres au moment du Send, alors qu'ils étaient déjà présent dans l'adresse que je fournissais à la requêtes...:aie: Bref, par orgueil je place mon code qui marche! :D

Humm...pas chez moi...et vérifier même si ma proposition fonctionne ! Quand je la lance après la tienne problème ! Quand je referme attend un peu et relance la mienne ok mais j'ai l'impression que c'est instable.
Il faudrait faire plus de tests.
A+
09/01/2015, 10h41
Marc-L

Citation:

Envoyé par Qwazerty

Marc-L, peux tu développer ton idée, je ne comprend pas.
Je peux me tromper, mais je pense que tu sous-estimes le problème.

Salut Stéphane !

En fait c'est une question que j'ai posé deux fois et toujours sans réponse
et pourtant ce n'est pas difficile à tester ! Sans avoir plus d'information je n'ai donc rien proposé …

L'idée est simple, si le libellé - pas la date - se termine par _libe_1 (colis livré) sur une référence
et sur une autre la même terminaison signifie la même chose, aucun besoin donc de télécharger
l'image pour la transformer en texte !

David, évidemment une requête est bien plus rapide que de piloter IE.
J'attendais que mgelec progresse enfin avec son navigateur et en lecture du contenu d'une variable
- débutant en la matière - avant de le lui évoquer.
Dans ce cas ne pas oublier de lui indiquer le tutoriel VBA et développement Web
tout comme les nombreux exemples dans les discussions de ce forum !
Sans compter les abeilles mais là ce n'est plus pour débutant …

_________________________________________________________________________________________________
Je suis Charlie

Sans liberté de la presse, pas de Liberté !

Un scientifique lira des centaines de livres au cours de sa vie, mais sera toujours persuadé qu'il lui reste beaucoup à apprendre.
Un religieux n'en lira qu'un et sera persuadé d'avoir tout compris …

Qwazerty je te remercie vraiment pour ton aide.
Tes requêtes m'ont beaucoup aidé et ça à l'air de fonctionner à présent.
Pour récupérer les adresses, j'ai fait un peu différemment en pointant tous les éléments images.

Le code de Qwazerty un peu modifié, j'ai fait une fonction pour la récupération et la sauvegarde de l'image.

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
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
Option Explicit
 
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(Url2 As String, URLImg2 As String, IEDoc As HTMLDocument, Dest As String)
 
Dim DemandeFichier As New MSXML2.XMLHTTP 'activer Microsoft XML dans les références
Dim StreamFile As New ADODB.Stream 'activer M$ ActiveX Data Object Lib
 
   'On génère la requête
    With DemandeFichier
        .Open "GET", URLImg2, False
        .setRequestHeader "Accept", "image/png, image/svg+xml, image/*;q=0.8, */*;q=0.5"
        .setRequestHeader "Accept-Encoding", "gzip , deflate"
        '.setRequestHeader "Content-Type", "application/x-www-form-urlencoded; charset=UTF-8"  'Ajouté
        .setRequestHeader "Cache-Control", "max-age=0"  'Ajouté
        .setRequestHeader "Accept-Language", "fr,fr-fr;q=0.8,en-us;q=0.5,en;q=0.3"
        .setRequestHeader "Connection", "keep-alive" 'Modifié, espace retiré "keep -alive"
        .setRequestHeader "Host", "www.colissimo.fr"
        .setRequestHeader "Referer", Url2
        .setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.0; rv:29.0) Gecko/20100101 Firefox/29.0"
        .setRequestHeader "Cookies", IEDoc.cookie
 
        'On l'exécute la requête
        .send '"styleBold=true&width=75&id=fr_23867263_date_1" 'les paramètres sont déjà inclus dans URLImg...
 
        'On copie les données dans un fichier
        StreamFile.Type = 1                              'binary
        StreamFile.Open
        StreamFile.write .responseBody
        StreamFile.SaveToFile Dest, 2                'overwrite
        StreamFile.Close
    End With
 
End Sub
 
 
Sub Colissimo()
 
Dim IE As New InternetExplorer
Dim IEDoc As HTMLDocument
Dim Generic As HTMLGenericElement
 
Dim Url As String
Dim TagItem As IHTMLElement
Dim TagItem1 As IHTMLElement
Dim TagItem2 As IHTMLElement
 
Dim ImgElem As IHTMLElementCollection
 
Dim URLImg As String
Dim URLImg1 As String
Dim URLImg2 As String
 
'Ouvre la page WEB
Url = "http://www.colissimo.fr/portail_colissimo/suivre.do?m=10003005&colispart=8J00238672635"
IE.Visible = True
IE.navigate Url
WaitIE IE
Set IEDoc = IE.document
 
'On pointe tous les éléments images
 
Set ImgElem = IEDoc.getElementsByTagName("img")
 
'On séléctionne l'adresse de l'image qui nous intéresse dans la collection
 
Set TagItem = ImgElem(7)
Set TagItem1 = ImgElem(8)
Set TagItem2 = ImgElem(9)
 
URLImg = TagItem.href
URLImg1 = TagItem1.href
URLImg2 = TagItem2.href
 
'On sauvegarde l'image dans un répertoire
 
SaveHtmlFile Url, URLImg, IEDoc, "c:\image\Date.png"
SaveHtmlFile Url, URLImg1, IEDoc, "c:\image\Libellé.png"
SaveHtmlFile Url, URLImg2, IEDoc, "c:\image\Site.png"
 
 
Set IE = Nothing
Set IEDoc = Nothing
 
'AjoutImage "c:\image\Date.png"
 
End Sub

A la base l'idée était d'intégrer les informations sous forme de texte dans les cellules en face des clients.
Celles-ci étant sous forme d'images, je me dis que que ce n'est pas forcément gênant.
Est-il possible d'intégrer ces images dans des cellules sous Excel?
Pour le moment j'ai réussi à ajouter une image sous Excel mais elle se place n'importe où et est énorme.

http://i38.servimg.com/u/f38/15/00/68/55/sans_t13.jpg

09/01/2015, 12h09
Marc-L

Citation:

Envoyé par Marc-L

En fait c'est une question que j'ai posé deux fois et toujours sans réponse
et pourtant ce n'est pas difficile à tester ! Sans avoir plus d'information je n'ai donc rien proposé …

L'idée est simple, si le libellé - pas la date - se termine par _libe_1 (colis livré) sur une référence
et sur une autre la même terminaison signifie la même chose, aucun besoin donc de télécharger
l'image pour la transformer en texte !

Dans cette hypothèse, pas besoin d'une usine à gaz, moins de vingt lignes de code sont nécessaires !

__________________________________________________________________________________________________
Je suis Charlie
09/01/2015, 13h47
Qwazerty

Salut

Marc-L, regarde le code source de la page, soit je passe à coté de quelques choses et donc vient nous en aide, soit ... c'est toi qui passe à coté de quelques choses :wink:
Visiblement le même texte contenu dans deux images ne donne pas le même "suffixe", celui-ci semble donc uniquement indiquer la ligne sur laquelle l'image se trouve, rien de plus.

++
Qwaz
09/01/2015, 14h14
Marc-L

Dans l'unique lien fourni, toutes les images se terminent en "_libe_X", "X" représentant un nombre …

Donc si le demandeur vérifie enfin dans le lien d'un autre colis si ce sont les mêmes suffixes,
il faut juste quatre lignes de code pour lire l'adresse de l'image du libellé le plus récent !

__________________________________________________________________________________________________
Je suis Charlie

Bonjour,
histoire d'avancer sur le téléchargement des images sélectionnées :

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
72
73
74
Option Explicit
 
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
 
 
Const strURL As String = "http://www.colissimo.fr/portail_colissimo/suivre.do?m=10003005&colispart=8J00238672635" 'URL du site
Const strFileURL As String = "http://www.colissimo.fr/portail_colissimo/" 'préfixe de l'URL des images
 
 
Sub XmlHttpRequest_Api()
Dim oXmlHttp As Object
Dim HtmlFile As Object
Dim oStream As Object
Dim colImg As Object
Dim Img As Object
Dim HtmlDoc As String
Dim strPathName As String
Dim strPathFileName As String
Dim i As Byte
 
 
Set oXmlHttp = CreateObject("Microsoft.XMLHTTP")
 
 
oXmlHttp.Open "GET", strURL, False
oXmlHttp.send
 
 
If oXmlHttp.Status = 200 Then HtmlDoc = oXmlHttp.responseText
 
 
If HtmlDoc <> vbNullString Then
  strPathName = GetDesktopFolder & "\" & "téléchargement" & "\"
 
  On Error Resume Next
  MkDir strPathName
  On Error GoTo 0
 
  Set HtmlFile = CreateObject("HTMLFile")
  HtmlFile.write HtmlDoc
 
  Set oStream = CreateObject("ADODB.Stream")
  oStream.Open
  oStream.WriteText HtmlDoc
  oStream.Close
 
  Set colImg = HtmlFile.images
 
 
  For Each Img In colImg
    If Img.href Like "about:imageio?*" Then
      i = i + 1
      strPathFileName = strFileURL & Replace(Img.href, "about:", vbNullString)
      URLDownloadToFile 0, strPathFileName, strPathName & "image_" & i & ".png", 0, 0
    End If
  Next Img
 
  Set oXmlHttp = Nothing
  Set oStream = Nothing
  Set HtmlFile = Nothing
  Set colImg = Nothing
  Set Img = Nothing
 
End If
End Sub
 
 
Function GetDesktopFolder()
Dim oShell As Object
  Set oShell = CreateObject("WScript.Shell")
  GetDesktopFolder = oShell.SpecialFolders("Desktop")
End Function

A+

Voir 40 message(s) de cette discussion en une page