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

Version imprimable

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

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

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