Macro VBA interactive IE ne fonctionne pas sans point d'arrêt

Version imprimable

20/02/2016, 11h57
dad76600

1 pièce(s) jointe(s)

Macro VBA interactive IE ne fonctionne pas sans point d'arrêt

Bonjour à tous,

J'ai une macro qui est chargée de récupérer le statut d'un colis sur le site de colissimo et de le retranscrire dans une cellule définie.

Celle-ci fonctionne uniquement (entendre : récupère le texte souhaité) si je met un point d'arrêt à un endroit précis.

Je met en pièce jointe le fichier et dans la macro, il est indiqué à quel endroit je dois mettre ce point d'arrêt pour que le texte récupéré soit bon, en l’occurrence, sur le fichier exemple, la macro doit récupérer le texte "votre colis est livré".

Quelqu'un aurait-il déjà eu ce problème et si oui, comment le résoudre svp ?

Merci à tous par avance pour vos suggestions/solutions.

Dadxl

1 pièce(s) jointe(s)

Bonjour encore un soucis avec la gestion d'attentes
je sais pas ce qui font les ebmasters en cemoment mais ils déraillent
bon !!!
au grand mot les grands remèdes on vire ie et on utilise une requete

cette macro te met tout les etapes de l'acheminement dans les cellules colonne G des references respectives
une requete est de toute manieres plus rapide
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 Sub test() Dim Req, url url = "http://www.colissimo.fr/portail_colissimo/suivre.do?language=fr_FR" For Each cel In Range("A2", Cells(Rows.Count, 1).End(xlUp)) Set Req = CreateObject("microsoft.xmlhttp") With Req .Open "POST", url, False .setRequestHeader "Content-Type", "application/x-www-form-urlencoded; charset=utf-8" .send "parcelnumber=" & Cel.Text & "&language=fr_FR" With CreateObject("htmlfile") .write Req.responseText compte_rendu = .getElementsByTagName("Table")(2).innerText cel.Offset(0, 6) = compte_rendu End With End With Next End Sub
Pièce jointe 201363

20/02/2016, 14h39
dad76600

Merci !

Bonjour patricktoulon !

Merci beaucoup. C'est top !

Je vais tacher de comprendre le fonctionnement de la requête et également essayer de la modifier pour n'obtenir que le dernier statut dans la colonne G et le premier statut dans la colonne F, ce que je devrais parvenir à faire je pense sans trop de difficultés, mais je me permet de ne pas mettre en résolu le topic pour le moment dans le cas ou j'aurais besoin de poursuivre cette discussion.

Merci encore au forum d'être si efficace et réactif !

re
ben c'est tout simple
au lieu de récupérer la table toute entière tu récupère la première ligne après la balise tbody

pour le nom tu la dans le div dans une balise h4 soit le premier enfant de ce div
donc se sera ce div .children(0)
mais dans ce h4 il y a plein de chose que tu veux pas alors tu split le texte
pour les adresse et code postal je ne sais pas ou les trouver on les vois pas sur la page

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Sub test()
    Dim Req, url
    url = "http://www.colissimo.fr/portail_colissimo/suivre.do?language=fr_FR"
    For Each cel In Range("A2", Cells(Rows.Count, 1).End(xlUp))
        Set Req = CreateObject("microsoft.xmlhttp")
        With Req
            .Open "POST", url, False
            .setRequestHeader "Content-Type", "application/x-www-form-urlencoded; charset=utf-8"
            .send "parcelnumber=" & cel.Text & "&language=fr_FR"
            With CreateObject("htmlfile")
                .write Req.responseText
                compte_rendu = .getElementsByTagName("Table")(2).getElementsByTagName("tbody")(0).getElementsByTagName("TR")(0).innerText
                cel.Offset(0, 6) = compte_rendu    'le dernier statut
                cel.Offset(0, 1) = Split(.getElementById("resultatSuivreDiv").Children(0).innerText, ":")(2)
            End With
        End With
    Next
End Sub

voili voilou wagadougou!!!!;)

20/02/2016, 17h22
dad76600

1 pièce(s) jointe(s)

re-bonjour,

Alors, j'ai pu adapter le code pour obtenir en G en H et en I les éléments liés au dernier statut en date du colis présent en colonne A. Je joins le fichier ainsi obtenu après exécution de la macro nommée test.

Ce que je cherche à faire maintenant, c'est d'obtenir la date d'envoi du colis en colonne J, ce qui me permettrait d'obtenir rapidement le délai de livraison.

En revanche, je ne sais quel élément du code html de la page utiliser pour arriver à mes fins. J'ai remarquer que le premier statut qui se situe donc le plus en bas dans la page web possède une balise intitulée "tr class="last" ; j'ai cherché à utiliser la procédure getelementsbyclassname sans succès. Je me suis aussi dit que je pouvais arriver à mes fins en cherchant la date correspondant au libellé "Votre colis a été déposé dans un point postal" qui correspond toujours au premier statut du colis, mais là encore je sèche.

Je continue mes recherches mais si un contributeur de ce forum peut m'aiguiller, je lui en serais très reconnaissant.

De nouveau, merci par avance des éventuelles réponses.

1 pièce(s) jointe(s)

action reaction ;)

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
Sub test()
    Dim Req, url
    url = "http://www.colissimo.fr/portail_colissimo/suivre.do?language=fr_FR"
    For Each cel In Range("A2", Cells(Rows.Count, 1).End(xlUp))
       On Error Resume Next
       Set Req = CreateObject("microsoft.xmlhttp")
        With Req
            .Open "POST", url, False
            .setRequestHeader "Content-Type", "application/x-www-form-urlencoded; charset=utf-8"
            .send "parcelnumber=" & cel.Text & "&language=fr_FR"
            With CreateObject("htmlfile")
                .write Req.responseText
                Set compte_rendu = .getElementsByTagName("Table")(2).getElementsByTagName("TBODY")(0).getElementsByTagName("TR")(0) 'toute la ligne
                cel.Offset(0, 1) = Split(.getElementById("resultatSuivreDiv").Children(0).innerText, ":")(2) 'LE NOM DE DESTINATION
                cel.Offset(0, 6) = compte_rendu.Children(1).innerText   'le dernier statut
                cel.Offset(0, 7) = compte_rendu.Children(0).innerText   'date de livraison ou dernier statut
                cel.Offset(0, 8) = compte_rendu.Children(2).innerText   'lieu  livraison
               'FIRST STATUT
               INDEX_STATUT = .getElementsByTagName("Table")(2).getElementsByTagName("TR").Length - 1
                 'date de depart
                 cel.Offset(0, 9) = .getElementsByTagName("Table")(2).getElementsByTagName("TR")(INDEX_STATUT).Children(0).innerText
                  End With
        End With
    Err.Clear
    Next
End Sub

Pièce jointe 201401

20/02/2016, 18h15
dad76600

Je ne sais pas quoi dire, quelle réactivité et en plus tout est bon du premier coup ! Je vais étudier le code pour tenter de le comprendre.

Merci, merci et encore merci.

Je marque la discussion en résolue, j'ai encore quelques ajustements à faire mais je pense pouvoir les gérer seul.

Bonne fin de journée et peut-être à bientôt sur un autre thème :D
20/02/2016, 18h19
patricktoulon

re

bonne utilisation et étude code ;)
il est assez simple sur cet exercice tu devrais pas avoir beaucoup de mal a le comprendre
20/02/2016, 19h04
dad76600

Format des dates

Aie !

Je pensais vraiment en avoir terminé mais un autre problème se pose.

Celui du format des dates qui sont toutes au format mois/jour/année (sauf étonnamment celle du 15 février) et que je n'arrive pas à convertir. Cela pose problème pour comptabiliser le délai entre le départ et l'arrivée.

J'ai bien sûr essayer de changer le format sans succès et essayer quelques codes trouvés par ci, par là sur le net.

Patrick, aurais-tu une solution pour cela aussi stp ?

David
20/02/2016, 19h45
dad76600

J'ai trouvé.

J'ai suivi ce lien http://www.developpez.net/forums/d49...b-format-date/ et ai ajouté un contrôle pour les colonnes ou il doit y avoir une date.

Donc je repasse en résolu et chercherais encore davantage au prochain problème rencontré.

Bonne soirée !

en fait il faut simplement mettre les colonnes h et j au format texte avant d'y mettre les dates

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
Sub test()
    Range("H:H,J:J").NumberFormat = "@"
    Dim Req, url
    url = "http://www.colissimo.fr/portail_colissimo/suivre.do?language=fr_FR"
    For Each cel In Range("A2", Cells(Rows.Count, 1).End(xlUp))
       On Error Resume Next
       Set Req = CreateObject("microsoft.xmlhttp")
        With Req
            .Open "POST", url, False
            .setRequestHeader "Content-Type", "application/x-www-form-urlencoded; charset=utf-8"
            .send "parcelnumber=" & cel.Text & "&language=fr_FR"
            With CreateObject("htmlfile")
                .write Req.responseText
                Set compte_rendu = .getElementsByTagName("Table")(2).getElementsByTagName("TBODY")(0).getElementsByTagName("TR")(0) 'toute la ligne
                cel.Offset(0, 1) = Split(.getElementById("resultatSuivreDiv").Children(0).innerText, ":")(2) 'LE NOM DE DESTINATION
                cel.Offset(0, 6) = compte_rendu.Children(1).innerText   'le dernier statut
                cel.Offset(0, 7) = compte_rendu.Children(0).innerText  'date de livraison ou dernier statut
                cel.Offset(0, 8) = compte_rendu.Children(2).innerText   'lieu  livraison
               'FIRST STATUT
               INDEX_STATUT = .getElementsByTagName("Table")(2).getElementsByTagName("TR").Length - 1
                 'date de depart
                 cel.Offset(0, 9) = .getElementsByTagName("Table")(2).getElementsByTagName("TR")(INDEX_STATUT).Children(0).innerText
                  End With
        End With
    Err.Clear
    Next
End Sub

26/03/2016, 12h07
dad76600

1 pièce(s) jointe(s)

Changement site internet colissimo

Bonjour patricktoulon et bonjour à tous,

Le fichier fonctionnait très bien jusqu'à ce que le site internet Colissimo n'accepte plus le suivi des numéros de colis que j'utilise pour une raison que j'ignore.

La seule solution est donc d'aller récupérer sur le site DHL (https://nolp.dhl.de/nextt-online-pub...FzYsgSVQ%3D%3D) le numéro d'expédition domestique commençant par 8K, de le stocker en colonne L par exemple sur l'onglet intitulé "Colis_Vides" et de poursuivre la recherche sur le site Colissimo avec le numéro de colis commençant par 8K .
Seulement, je ne sais pas intégrer dans une boucle deux requêtes web imbriquées.

Patricktoulon, tu connais le fichier que tu m'as gentiment construit en février, aurais-tu le temps stp de le reprendre pour le modifier tel que décrit ci-dessus stp ?
Ce serait très gentil à nouveau de ta part. Si d'autres veulent s'y plonger, n'hésitez pas à me transmettre vos suggestions/solutions.

Par avance, je vous remercie tous et vous souhaite un bon weekend de Pâques.

bonjour
perso j'ai un peu regardé et il n'est pas nécessaire de faire 2 requêtes puisque le nouveau site te donne aussi le dernier satut ainsi que le numéro domestique

tiens exemple

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
Sub actualisation_colis()
    Dim cel As Range, matable As Object, mestr As Object
    Application.ScreenUpdating = False
    With Sheets("Colis_Vides"): .Range("H:H,J:J").NumberFormat = "@": End With
    Dim Req, url
    For Each cel In Range("A2", Cells(Rows.Count, 1).End(xlUp))
        On Error Resume Next
        url = "https://nolp.dhl.de/nextt-online-public/set_identcodes.do?runtime=standalone&idc=" & cel & "++++&_sourcePage=%2FWEB-INF%2Fjsp%2Fquery.jsp&__fp=dLKvzwrxKQrEYIUoEacrdQ%3D%3D HTTP/1.1"
        Set Req = CreateObject("microsoft.xmlhttp")
        With Req
            .Open "get", url, False
            'Clé Valeur
            .setRequestHeader "Referer", "https://nolp.dhl.de/nextt-online-public/set_identcodes.do?runtime=standalone&idc=&_sourcePage=%2FWEB-INF%2Fjsp%2Fquery.jsp&__fp=3435oKg%2BWXE%2BCuFzYsgSVQ%3D%3D"
            .send
            With CreateObject("htmlfile")
                .write Req.responseText
                Set matable = .getElementsByTagName("table")(0)
                Set mestr = .getElementsByTagName("table")(0).getElementsByTagName("TR")
                cel.Offset(0, 1) = mestr(3).Children(2).innerText
                cel.Offset(0, 6) = mestr(4).Children(2).innerText
                cel.Offset(0, 7) = Split(mestr(4).Children(1).innerText, ",")(1) & "h"
                cel.Offset(0, 9) = Split(matable.getElementsByTagName("table")(0).Children(1).Children(0).Children(0).innerText, ",")(1)
            End With
        End With
        Err.Clear
    Next
 
    encadrer_si
    colorier
    controleLigne
    suppression_données_transférées
    Sheets("Colis_Vides").Select
    supVides
    filtre_tri
    Application.ScreenUpdating = True
End Sub

26/03/2016, 19h06
dad76600

Je viens de lire ta réponse et t'en remercie.

En revanche, je n'ai pas été assez précis dans mon post précédent et je m'en excuse.

J'ai vraiment besoin que les données rapportées dans excel soient celles du site colissimo car j'ai besoin, pour mes statistiques, de savoir le lieu de livraison (centre courrier , bureau de poste...), information qui n'est disponible que sur le site de colissimo.

Donc je pense qu'il faut faire cela en deux étapes.

As-tu une idée pour cela stp ?

Merci encore !

soit!

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
Sub actualisation_colis()
    Dim cel As Range, code As String, matable As Object, mestr As Object
    Dim compte_rendu, INDEX_STATUT As Variant
    Dim Req, url
    Application.ScreenUpdating = False
 
    With Sheets("Colis_Vides")
        .Range("H:H,J:J").NumberFormat = "@"
    End With
 
    For Each cel In Range("A2", Cells(Rows.Count, 1).End(xlUp))
        On Error Resume Next
 
        url = "https://nolp.dhl.de/nextt-online-public/set_identcodes.do?runtime=standalone&idc=" & cel & "++++&_sourcePage=%2FWEB-INF%2Fjsp%2Fquery.jsp&__fp=dLKvzwrxKQrEYIUoEacrdQ%3D%3D HTTP/1.1"
        Set Req = CreateObject("microsoft.xmlhttp")
        With Req
            .Open "get", url, False
            .setRequestHeader "Referer", "https://nolp.dhl.de/nextt-online-public/set_identcodes.do?runtime=standalone&idc=&_sourcePage=%2FWEB-INF%2Fjsp%2Fquery.jsp&__fp=3435oKg%2BWXE%2BCuFzYsgSVQ%3D%3D"
            .send
            With CreateObject("htmlfile")
                .write Req.responseText
                Set matable = .getElementsByTagName("table")(0)
                Set mestr = .getElementsByTagName("table")(0).getElementsByTagName("TR")
                code = mestr(3).Children(2).innerText
            cel.Offset(0, 1) = mestr(3).Children(2).innerText
            End With
        End With
 
        url = "http://www.colissimo.fr/portail_colissimo/suivre.do?language=fr_FR"
        Set Req = CreateObject("microsoft.xmlhttp")
        With Req
            .Open "POST", url, False
            .setRequestHeader "Content-Type", "application/x-www-form-urlencoded; charset=utf-8"
            .send "parcelnumber=" & code & "&language=fr_FR"
            With CreateObject("htmlfile")
                .write Req.responseText
                Set compte_rendu = .getElementsByTagName("Table")(2).getElementsByTagName("TBODY")(0).getElementsByTagName("TR")(0)    'toute la ligne
                cel.Offset(0, 5) = Split(.getElementById("resultatSuivreDiv").Children(0).innerText, ":")(2)    'LE NOM DE DESTINATION
                cel.Offset(0, 6) = compte_rendu.Children(1).innerText   'le dernier statut
                cel.Offset(0, 7) = compte_rendu.Children(0).innerText   'date de livraison ou dernier statut
                cel.Offset(0, 8) = compte_rendu.Children(2).innerText   'lieu  livraison
                'FIRST STATUT
                INDEX_STATUT = .getElementsByTagName("Table")(2).getElementsByTagName("TR").Length - 1
                'date de depart
                cel.Offset(0, 9) = .getElementsByTagName("Table")(2).getElementsByTagName("TR")(INDEX_STATUT).Children(0).innerText
            End With
        End With
        Err.Clear
    Next
 
    encadrer_si
    colorier
    controleLigne
    suppression_données_transférées
    sheets("Colis_Vides").Select
    supVides
    filtre_tri
 
    Application.ScreenUpdating = True
End Sub

;)

Bonjour à tous,

Merci, cela fonctionne correctement à une exception près.

Lorsque le suivi sur le site DHL n'a aucun suivi soit la mention "Aucune information n’est disponible sur l’envoi 436005042082." par exemple.

Lorsque c'est le cas, je souhaite que la macro indique en colonne G "aucune information disponible" et passe au colis suivant.

J'ai essayé d'appliquer une condition comme suit mais cela ne fonctionne pas :
Code:

1 2 3 4 5 6 7 8 9 .write Req.responseText Set matable = .getElementsByTagName("table")(0) Set mestr = .getElementsByTagName("table")(0).getElementsByTagName("TR") code = mestr(3).Children(2).innerText If "htmlfile" Like "*Aucune information*" Then cel.Offset(0, 6) = "aucune information" Else cel.Offset(0, 12) = mestr(3).Children(2).innerText End If
Une idée stp ? Et encore et toujours un grand merci pour ton aide.

27/03/2016, 13h02
cerede2000

@Patricktoulon comment a tu déterminer ceci :

Code:

.setRequestHeader "Referer", "https://nolp.dhl.de/nextt-online-public/set_identcodes.do?runtime=standalone&idc=&_sourcePage=%2FWEB-INF%2Fjsp%2Fquery.jsp&__fp=3435oKg%2BWXE%2BCuFzYsgSVQ%3D%3D"
27/03/2016, 13h04
Marc-L

Bonjour,

en regardant dans l'outil d'inspection d'un navigateur dans la section Réseau …

______________________________________________________________________________________________________
Je suis Paris, Charlie, Bruxelles, …
27/03/2016, 14h15
patricktoulon

re

re

Citation:

Lorsque le suivi sur le site DHL n'a aucun suivi soit la mention "Aucune information n’est disponible sur l’envoi 436005042082." par exemple.

Lorsque c'est le cas, je souhaite que la macro indique en colonne G "aucune information disponible" et passe au colis suivant.

organise un test "if" après la 2 Emme requête

je vais quand même faire tout a ta place
27/03/2016, 14h19
patricktoulon

Citation:

Envoyé par cerede2000

@Patricktoulon comment a tu déterminer ceci :

Code:

.setRequestHeader "Referer", "https://nolp.dhl.de/nextt-online-public/set_identcodes.do?runtime=standalone&idc=&_sourcePage=%2FWEB-INF%2Fjsp%2Fquery.jsp&__fp=3435oKg%2BWXE%2BCuFzYsgSVQ%3D%3D"

cerede2000 tu tape f12 et tu enregistre ce qui se passe après tu clique sur détail pour IE11 et Ie10

après tu fait ce que tu fait normalement sur ie après tu reviens sur l'inspecteur f12 et tu regarde les détail de la requête

ca fonctionne un peu comme un enregistreur de macro
27/03/2016, 16h33
cerede2000

Ah ok !
Merci :)

J'utilise beaucoup les outils de dev (F12) quand je fais du CSS mais je n'avais jamais été voir cette partie.

Merci, je ne demande pas à ce que tu fasses tout (quoi que malheureusement oui :( car je n'y parviens vraiment pas), ce que tu as déjà fait est très sympa !

Par contre, je n'ai pas le niveau et l'esprit suffisamment logique à mon avis car tu me dis de faire mon test conditionnel après la seconde requête mais je ne veux justement pas que la macro exécute la seconde requête pour la ligne en cours si la valeur de la variable code est nulle et qu'elle passe directement à la ligne suivante.

J'ai essayé de placer les instructions suivantes après la première requête tout de même (et d'autres façons de faire) mais je ne parviens pas au résultat souhaité ; voici le code en l'état actuel :

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
Sub actualisation_colis()
 
    Dim cel As Range, code As String, matable As Object, mestr As Object
    Dim compte_rendu, INDEX_STATUT As Variant
    Dim Req, url
 
Application.ScreenUpdating = False
 
 
With Sheets("Colis_Expedies")
.Range("H:H,J:J").NumberFormat = "@"
End With
 
    For Each cel In Range("A2", Cells(Rows.Count, 1).End(xlUp))
        On Error Resume Next
 
        url = "https://nolp.dhl.de/nextt-online-public/set_identcodes.do?runtime=standalone&idc=" & cel & "++++&_sourcePage=%2FWEB-INF%2Fjsp%2Fquery.jsp&__fp=dLKvzwrxKQrEYIUoEacrdQ%3D%3D HTTP/1.1"
        Set Req = CreateObject("microsoft.xmlhttp")
        With Req
            .Open "get", url, False
            .setRequestHeader "Referer", "https://nolp.dhl.de/nextt-online-public/set_identcodes.do?runtime=standalone&idc=&_sourcePage=%2FWEB-INF%2Fjsp%2Fquery.jsp&__fp=3435oKg%2BWXE%2BCuFzYsgSVQ%3D%3D"
            .send
            With CreateObject("htmlfile")
                .write Req.responseText
                Set matable = .getElementsByTagName("table")(0)
                Set mestr = .getElementsByTagName("table")(0).getElementsByTagName("TR")
                code = mestr(3).Children(2).innerText
            End With
        End With
        If code = "" Then
        GoTo Chemin_1
        Else
        GoTo Chemin_2
        End If
 
Chemin_1:
        url = "http://www.colissimo.fr/portail_colissimo/suivre.do?language=fr_FR"
        Set Req = CreateObject("microsoft.xmlhttp")
        With Req
            .Open "POST", url, False
            .setRequestHeader "Content-Type", "application/x-www-form-urlencoded; charset=utf-8"
            .send "parcelnumber=" & code & "&language=fr_FR"
            With CreateObject("htmlfile")
                .write Req.responseText
                Set compte_rendu = .getElementsByTagName("Table")(2).getElementsByTagName("TBODY")(0).getElementsByTagName("TR")(0) 'toute la ligne
                cel.Offset(0, 5) = Split(.getElementById("resultatSuivreDiv").Children(0).innerText, ":")(2) 'LE NOM DE DESTINATION
                cel.Offset(0, 6) = compte_rendu.Children(1).innerText   'le dernier statut
                cel.Offset(0, 7) = compte_rendu.Children(0).innerText   'date de livraison ou dernier statut
                cel.Offset(0, 8) = compte_rendu.Children(2).innerText   'lieu  livraison
               'FIRST STATUT
                INDEX_STATUT = .getElementsByTagName("Table")(2).getElementsByTagName("TR").Length - 1
                 'date de depart
                 cel.Offset(0, 9) = .getElementsByTagName("Table")(2).getElementsByTagName("TR")(INDEX_STATUT).Children(0).innerText
            End With
        End With
    Err.Clear
 
        Next
 
Chemin_2:
 
'encadrer_si
'
'colorier
'
'controleLigne
'
'suppression_données_transférées
'
'Sheets("Colis_Expedies").Select
'
'supVides
'
'filtre_tri
 
 
Application.ScreenUpdating = True
 
End Sub

Désolé d'être bête mais c'est tellement frustrant de n'avoir plus qu'une étape pour que le fichier soit fonctionnel et de ne pas y parvenir que j'ose demander une nouvelle fois si quelqu'un peut me donner la solution ou une piste assez avancée car manifestement, mes capacités de compréhension du "codage" sont très limitées.

RE pour le teste

re
BON C EST LA DER DES DER OK
et li les commentaires dans le code

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
Sub actualisation_colis()
 
    Dim cel As Range, code As String, matable As Object, mestr As Object
    Dim compte_rendu, INDEX_STATUT As Variant
    Dim Req, url
 
Application.ScreenUpdating = False
 
 
With Sheets("Colis_Expedies")
.Range("H:H,J:J").NumberFormat = "@"
End With
 
    For Each cel In Range("A2", Cells(Rows.Count, 1).End(xlUp))
        On Error Resume Next
 
        url = "https://nolp.dhl.de/nextt-online-public/set_identcodes.do?runtime=standalone&idc=" & cel & "++++&_sourcePage=%2FWEB-INF%2Fjsp%2Fquery.jsp&__fp=dLKvzwrxKQrEYIUoEacrdQ%3D%3D HTTP/1.1"
        Set Req = CreateObject("microsoft.xmlhttp")
        With Req
            .Open "get", url, False
            .setRequestHeader "Referer", "https://nolp.dhl.de/nextt-online-public/set_identcodes.do?runtime=standalone&idc=&_sourcePage=%2FWEB-INF%2Fjsp%2Fquery.jsp&__fp=3435oKg%2BWXE%2BCuFzYsgSVQ%3D%3D"
            .send
            With CreateObject("htmlfile")
                .write Req.responseText
                'C EST ICI QU IL FAUT METTRE TA  CONDITION ET CODE NE RENVOIE PAS 0 OU RIEN SIL
                ' UNE ERREUR MAIS UN MESSAGE ALORS ON TESTE UN PARTIE DE CE MESSAGE
                ' J AI DEPLACE CHEMIN82 JE L AI REMIS DANS LA BOUCLE SINON DES LA PROCHAINE ERREUR IL SORT DE LA BOUCLE ET NE RAIT PLUS LA SUIVANTE
                If InStr(.body.innerText, "We do not currently have information about shipment") > 0 Then GoTo Chemin_2
                Set matable = .getElementsByTagName("table")(0)
                Set mestr = .getElementsByTagName("table")(0).getElementsByTagName("TR")
                code = mestr(3).Children(2).innerText
            End With
        End With
 
 
Chemin_1:
        url = "http://www.colissimo.fr/portail_colissimo/suivre.do?language=fr_FR"
        Set Req = CreateObject("microsoft.xmlhttp")
        With Req
            .Open "POST", url, False
            .setRequestHeader "Content-Type", "application/x-www-form-urlencoded; charset=utf-8"
            .send "parcelnumber=" & code & "&language=fr_FR"
            With CreateObject("htmlfile")
                .write Req.responseText
                Set compte_rendu = .getElementsByTagName("Table")(2).getElementsByTagName("TBODY")(0).getElementsByTagName("TR")(0) 'toute la ligne
                cel.Offset(0, 5) = Split(.getElementById("resultatSuivreDiv").Children(0).innerText, ":")(2) 'LE NOM DE DESTINATION
                cel.Offset(0, 6) = compte_rendu.Children(1).innerText   'le dernier statut
                cel.Offset(0, 7) = compte_rendu.Children(0).innerText   'date de livraison ou dernier statut
                cel.Offset(0, 8) = compte_rendu.Children(2).innerText   'lieu  livraison
               'FIRST STATUT
                INDEX_STATUT = .getElementsByTagName("Table")(2).getElementsByTagName("TR").Length - 1
                 'date de depart
                 cel.Offset(0, 9) = .getElementsByTagName("Table")(2).getElementsByTagName("TR")(INDEX_STATUT).Children(0).innerText
            End With
        End With
    Err.Clear
Chemin_2: ' C EST ICI QUE DOIT ETRE CHEMIN_2
        Next
 
 
'encadrer_si
'
'colorier
'
'controleLigne
'
'suppression_données_transférées
'
'Sheets("Colis_Expedies").Select
'
'supVides
'
'filtre_tri
 
 
Application.ScreenUpdating = True
 
End Sub

après si tu n'y arrive pas commence par apprendre les bases avant de te lancer dans les manipulation vba/IE
on peut pas toujours tout faire a ta place si tu n'y arrive pas c'est que tu sais pas faire alors apprends avant de commencer
je suivrais l'évolution

Bonjour,

Le site colissimo accepte de nouveau le suivi de numéro de colis importés d'Allemagne donc le code du début de ce topic fonctionne de nouveau.

Par ailleurs, je remet tout de même ci-dessous le code qui va récupérer le numéro colissimo sur le site de dhl avant de faire la recherche d'informations sur le site de colissimo au cas où le site colissimo refuserait, à l'avenir, de nouveau les numéros de colis importés. Je repasse aussi le topic en résolu.

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
Sub actualisation_colis() ' par patricktoulon du site developpez.net
 
    Dim cel As Range, code As String, matable As Object, mestr As Object
    Dim compte_rendu, INDEX_STATUT As Variant
    Dim Req, url
 
Application.ScreenUpdating = False 'ne pas rafraichir l'écran
 
 
With Sheets("Colis_Expedies") ' avec la feuille intitulée "Colis_Expedies"
.Range("H:H,J:J").NumberFormat = "@" 'permet de forçer le format des dates des colonnes H et J au format français
End With
 
With Sheets("Colis_Expedies")
    For Each cel In Range("A2", Cells(Rows.Count, 1).End(xlUp)) 'pour chaque cellule de la colonne A
        On Error Resume Next
 
        url = "https://nolp.dhl.de/nextt-online-public/set_identcodes.do?runtime=standalone&idc=" & cel & "++++&_sourcePage=%2FWEB-INF%2Fjsp%2Fquery.jsp&__fp=dLKvzwrxKQrEYIUoEacrdQ%3D%3D HTTP/1.1" 'définit l'URL à utiliser
        Set Req = CreateObject("microsoft.xmlhttp") 
        With Req
            .Open "get", url, False
            .setRequestHeader "Referer", "https://nolp.dhl.de/nextt-online-public/set_identcodes.do?runtime=standalone&idc=&_sourcePage=%2FWEB-INF%2Fjsp%2Fquery.jsp&__fp=3435oKg%2BWXE%2BCuFzYsgSVQ%3D%3D"
            .send
            With CreateObject("htmlfile")
                .write Req.responseText
                Set matable = .getElementsByTagName("table")(0)
                Set mestr = .getElementsByTagName("table")(0).getElementsByTagName("TR")
                code = mestr(3).Children(2).innerText
                If code Like "8K*" Then
                cel.Offset(0, 11).Value = code
                GoTo Chemin_1 ' si la valeur de la variable code commençe par 8K, on copie cette valeur dans la colonne L et on va à l'instruction Chemin_1
                End If
                If Not code Like "8K*" Then
                cel.Offset(0, 11).Value = "aucune correspondance"
                GoTo Chemin_2 ' si la valeur de la variable ne commençe pas par 8K, on indique la mention aucune correspondance en colonne L et on va à l'instruction Chemin_2 soit la prochaine cellule
                End If
            End With
        End With
    Err.Clear
    Set Req = Nothing
 
 
Chemin_1:
        url = "http://www.colissimo.fr/portail_colissimo/suivre.do?language=fr_FR"
        Set Req = CreateObject("microsoft.xmlhttp")
        With Req
            .Open "POST", url, False
            .setRequestHeader "Content-Type", "application/x-www-form-urlencoded; charset=utf-8"
            .send "parcelnumber=" & code & "&language=fr_FR"
            With CreateObject("htmlfile")
                .write Req.responseText
                Set compte_rendu = .getElementsByTagName("Table")(2).getElementsByTagName("TBODY")(0).getElementsByTagName("TR")(0) 'toute la ligne
                cel.Offset(0, 5) = Split(.getElementById("resultatSuivreDiv").Children(0).innerText, ":")(2) 'LE NOM DE DESTINATION
                cel.Offset(0, 6) = compte_rendu.Children(1).innerText   'le dernier statut
                cel.Offset(0, 7) = compte_rendu.Children(0).innerText   'date de livraison ou dernier statut
                cel.Offset(0, 8) = compte_rendu.Children(2).innerText   'lieu  livraison
               'FIRST STATUT
                INDEX_STATUT = .getElementsByTagName("Table")(2).getElementsByTagName("TR").Length - 1
                 'date de depart
                 cel.Offset(0, 9) = .getElementsByTagName("Table")(2).getElementsByTagName("TR")(INDEX_STATUT).Children(0).innerText
            End With
        End With
    Err.Clear
 
    code = ""
 
Chemin_2:
        Next cel
End With
 
 
Application.ScreenUpdating = True ' réactive le rafraîchissement de l'écran
 
End Sub

Un dernier merci et bon weekend à tous !

ps : patricktoulon, j'ai commandé ce livre http://www.editions-eni.fr/livres/ma...d03e19775.html qui je l'espère, me permettra de me former correctement