probléme pour recupération des dates d'un fichier xml sous VBA

**gibba88** · 22/05/2012, 09h58

bonjour ,j'ai un soucis avec mon code . en faite c'est un fichier xml que je traite sous excel .
le programme marche mais seulement j'ai un petit probléme avec l'importation des dates "date debut" et "date de fin"

voici une partie du fichier xml que je dois parcourir les nodes et comparer les date afin de récupérer la date de début de test (la date plus ancienne) et la date de fin de test (la date plus ressente.)

Code xml :

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
72
73
 <TM_Common>
    <TestReportID>479e6e58-4868-45f7-ac81-00ca5fc8a3e1</TestReportID>
    <TestReportOrder>53</TestReportOrder>
    <Name>OMICRON State Sequencer</Name>
    <Version>2.40 </Version>
    <Title>2-2-2-TEST TPHD_</Title>
    <TestStartDate>2012-02-24T11:18:35+01:00</TestStartDate>
    <TestEndDate>2012-02-24T11:18:53+01:00</TestEndDate>
    <Offline>false</Offline>
    <Overload>false</Overload>
    <HWCReportOrder>45</HWCReportOrder>
    <TOReportOrder>1</TOReportOrder>
    <Assessment>PASSED</Assessment>
    <ManualAssessment>false</ManualAssessment>
    <Error>false</Error>
    <TestStartMode>IMMEDIATELY</TestStartMode>
  </TM_Common>
  <TM_Common>
    <TestReportID>479e6e58-4868-45f7-ac81-00ca5fc8a3e1</TestReportID>
    <TestReportOrder>54</TestReportOrder>
    <Name>OMICRON Ramping</Name>
    <Version>2.40 </Version>
    <Title>2-3-Protection Phase - DJ Fermé_</Title>
    <TestStartDate>2012-02-24T11:18:59+01:00</TestStartDate>
    <TestEndDate>2012-02-24T11:19:02+01:00</TestEndDate>
    <Offline>false</Offline>
    <Overload>false</Overload>
    <HWCReportOrder>45</HWCReportOrder>
    <TOReportOrder>1</TOReportOrder>
    <Assessment>PASSED</Assessment>
    <ManualAssessment>false</ManualAssessment>
    <Error>false</Error>
    <TestStartMode>IMMEDIATELY</TestStartMode>
  </TM_Common>
  <TM_Common>
    <TestReportID>479e6e58-4868-45f7-ac81-00ca5fc8a3e1</TestReportID>
    <TestReportOrder>55</TestReportOrder>
    <Name>Module OMICRON Pause</Name>
    <Version>2.40 </Version>
    <Title>2-3-0-Action RRL ES_</Title>
    <TestStartDate>2012-02-24T11:19:06+01:00</TestStartDate>
    <TestEndDate>2012-02-24T11:19:23+01:00</TestEndDate>
    <Offline>false</Offline>
    <Overload>false</Overload>
    <HWCReportOrder>45</HWCReportOrder>
    <TOReportOrder>1</TOReportOrder>
    <Assessment>PASSED</Assessment>
    <ManualAssessment>false</ManualAssessment>
    <Error>false</Error>
    <Comment>Positionner les Réenclencheurs En Service
Fermer le DJ départ</Comment>
    <TestStartMode>IMMEDIATELY</TestStartMode>
  </TM_Common>
  <TM_Common>
    <TestReportID>479e6e58-4868-45f7-ac81-00ca5fc8a3e1</TestReportID>
    <TestReportOrder>56</TestReportOrder>
    <Name>Module OMICRON Pause</Name>
    <Version>2.40 </Version>
    <Title>2-3-0-a-Libellé IT DJ Fermé</Title>
    <TestStartDate>2012-02-24T11:19:27+01:00</TestStartDate>
    <TestEndDate>2012-02-24T11:19:48+01:00</TestEndDate>
    <Offline>false</Offline>
    <Overload>false</Overload>
    <HWCReportOrder>45</HWCReportOrder>
    <TOReportOrder>1</TOReportOrder>
    <Assessment>PASSED</Assessment>
    <ManualAssessment>false</ManualAssessment>
    <Error>false</Error>
    <Comment>DEPn           ACQUIT DJ               Positif 22
DEPn           COMMANDE DJ        Fermé Local
DEPn           POSITION DJ           Fermé Local</Comment>
    <TestStartMode>IMMEDIATELY</TestStartMode>
  </TM_Common>

voici mon programme .mais il me recupére seulement les 2 derniére dates

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
'Date Debut et Fin du Test
Sub Date_du_Test(xmlDoc As DOMDocument)
Dim oNode As IXMLDOMElement
Dim oElement As IXMLDOMElement
 
For Each oNode In xmlDoc.getElementsByTagName("TM_Common")
    'Pour boucler dans les balises
    For Each oElement In oNode.ChildNodes
         If oElement.nodeName = "TestStartDate" Then
            ActiveSheet.Cells(1, 1) = "DEB TEST:"
            ActiveSheet.Cells(1, 2) = oElement.nodeTypedValue
        End If
        If oElement.nodeName = "TestEndDate" Then
            ActiveSheet.Cells(1, 7) = "FIN TEST:"
            ActiveSheet.Cells(1, 8) = oElement.nodeTypedValue
        End If
    Next oElement
Next oNode
End Sub

**tedo01** · 22/05/2012, 12h00

Bonjour,

C'est logique, car tu écris les dates les unes après les autres dans la même cellule, sans rien tester. A la fin il ne reste donc que les dernières dates.
Pour récupérer les bonnes date, il faut vérifier à chaque fois si la date début est plus ancienne et la date de fin plus récente :

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
'Date Debut et Fin du Test
Sub Date_du_Test(xmlDoc As DOMDocument)
Dim oNode As IXMLDOMElement
Dim oElement As IXMLDOMElement
 
For Each oNode In xmlDoc.getElementsByTagName("TM_Common")
    'Pour boucler dans les balises
    For Each oElement In oNode.ChildNodes
         If oElement.nodeName = "TestStartDate" Then
            ' Si la cellule est vide, ou si la date lue dans le XML est plus ancienne que celle de la cellule
            If IsEmpty(ActiveSheet.Cells(1, 2)) Or ActiveSheet.Cells(1, 2) > oElement.nodeTypedValue Then
                ActiveSheet.Cells(1, 1) = "DEB TEST:"
                ActiveSheet.Cells(1, 2) = oElement.nodeTypedValue
            End If
        End If
        If oElement.nodeName = "TestEndDate" Then
            ' Si la cellule est vide, ou si la date lue dans le XML est plus récente que celle de la cellule
            If IsEmpty(ActiveSheet.Cells(1, 2)) Or ActiveSheet.Cells(1, 2) < oElement.nodeTypedValue Then
                ActiveSheet.Cells(1, 7) = "FIN TEST:"
                ActiveSheet.Cells(1, 8) = oElement.nodeTypedValue
            End If
        End If
    Next oElement
Next oNode
End Sub

**gibba88** · 22/05/2012, 14h37

Merci tedo01 votre procédure a bien marché

.Enfaite ,je suis débutant en VBA

et j'ai du mal a maitriser les syntaxes. Si possible est ce vous pouvez regarder mon procédure (ci-dessous) ,il me permet de recupérer les données d'un fichier xml.il marche bien mais le soucis est qu'il est un peu long donc j'aimerais le simplifier.

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
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
 
 
Option Explicit
'test Réenclenchement
Sub Reenclencheur(xmlDoc As DOMDocument)
'Déclaration des variables
Dim oNode As IXMLDOMElement
Dim oElement As IXMLDOMElement
Dim oRoot As IXMLDOMElement
 
Dim i As Integer
Dim j As Integer
Dim fixe
Dim k As Byte
 
'éléments fixes
fixe = Array("TRP", "TL1P", "TL2P", "TRH", "TL1H", "TL2H")
For i = 23 To 28
    For j = 9 To 9
        With ActiveSheet
            .Cells(i, j).Value = fixe(k)
        End With
        k = k + 1
    Next j
    For j = 13 To 13
        ActiveSheet.Cells(i, j) = "NonRéalisé"
    Next j
Next i
'Pour extraire les éléments du cycle "Réenclencheur, on Boucle dans la balise <Seq_Measurement></Seq_Measurement>
  For Each oNode In xmlDoc.getElementsByTagName("Seq_Measurement")
      'on accéde à l'élément "Name"
        Set oElement = oNode.getElementsByTagName("Name")(0)
        If Not oElement Is Nothing Then
            'on recupére les données du testTRP Si le noeud <Name>=1-TRP
            If oElement.nodeName = "Name" And Right(oElement.nodeTypedValue, 3) = "TRP" Then
                For Each oElement In oNode.ChildNodes
                    If oElement.nodeName = "Tnom" Then
                        ActiveSheet.Cells(23, 10) = oElement.nodeTypedValue
                    End If
                    ActiveSheet.Cells(23, 11) = "s"
                    If oElement.nodeName = "Tact" Then
                        ActiveSheet.Cells(23, 12) = oElement.nodeTypedValue
                    End If
                    If oElement.nodeName = "Assessment" Then
                        If oElement.nodeTypedValue = "PASSED" Then
                            ActiveSheet.Cells(23, 13) = "Réussi"
                        Else
                            ActiveSheet.Cells(23, 13) = "Echec"
                        End If
                    End If
                Next oElement
            End If
        End If
        'Set oElement = oNode.getElementsByTagName("Name")(0)
        If Not oElement Is Nothing Then
         'on recupére les données du testTRP Si le noeud <Name>=1-TL1P
            If oElement.nodeName = "Name" And Right(oElement.nodeTypedValue, 4) = "TL1P" Then
                For Each oElement In oNode.ChildNodes
                    If oElement.nodeName = "Tnom" Then
                        ActiveSheet.Cells(24, 10) = oElement.nodeTypedValue
                    End If
                    ActiveSheet.Cells(24, 11) = "s"
                    If oElement.nodeName = "Tact" Then
                        ActiveSheet.Cells(24, 12) = oElement.nodeTypedValue
                    End If
                    If oElement.nodeName = "Assessment" Then
                        If oElement.nodeTypedValue = "PASSED" Then
                            ActiveSheet.Cells(24, 13) = "Réussi"
                        Else
                            ActiveSheet.Cells(24, 13) = "Echec"
                        End If
                    End If
                Next oElement
            End If
        End If
        If Not oElement Is Nothing Then
         'on recupére les données du testTRP Si le noeud <Name>=1-TL2P
            If oElement.nodeName = "Name" And Right(oElement.nodeTypedValue, 4) = "TL2P" Then
                For Each oElement In oNode.ChildNodes
                    If oElement.nodeName = "Tnom" Then
                        ActiveSheet.Cells(25, 10) = oElement.nodeTypedValue
                    End If
                    ActiveSheet.Cells(25, 11) = "s"
                    If oElement.nodeName = "Tact" Then
                        ActiveSheet.Cells(25, 12) = oElement.nodeTypedValue
                    End If
                    If oElement.nodeName = "Assessment" Then
                        If oElement.nodeTypedValue = "PASSED" Then
                            ActiveSheet.Cells(25, 13) = "Réussi"
                        Else
                            ActiveSheet.Cells(25, 13) = "Echec"
                        End If
                    End If
                Next oElement
            End If
        End If
        If Not oElement Is Nothing Then
            'on recupére les données du testTRP Si le noeud <Name>=1-TRH
            If oElement.nodeName = "Name" And Right(oElement.nodeTypedValue, 3) = "TRH" Then
                For Each oElement In oNode.ChildNodes
                    If oElement.nodeName = "Tnom" Then
                        ActiveSheet.Cells(26, 10) = oElement.nodeTypedValue
                    End If
                    ActiveSheet.Cells(26, 11) = "s"
                    If oElement.nodeName = "Tact" Then
                        ActiveSheet.Cells(26, 12) = oElement.nodeTypedValue
                    End If
                    If oElement.nodeName = "Assessment" Then
                        If oElement.nodeTypedValue = "PASSED" Then
                            ActiveSheet.Cells(26, 13) = "Réussi"
                        Else
                            ActiveSheet.Cells(26, 13) = "Echec"
                        End If
                    End If
                Next oElement
            End If
        End If
        Set oElement = oNode.getElementsByTagName("Name")(0)
        If Not oElement Is Nothing Then
         'on recupére les données du testTRP Si le noeud <Name>=1-TL1H
            If oElement.nodeName = "Name" And Right(oElement.nodeTypedValue, 4) = "TL1H" Then
                For Each oElement In oNode.ChildNodes
                    If oElement.nodeName = "Tnom" Then
                        ActiveSheet.Cells(27, 10) = oElement.nodeTypedValue
                    End If
                    ActiveSheet.Cells(27, 11) = "s"
                    If oElement.nodeName = "Tact" Then
                        ActiveSheet.Cells(27, 12) = oElement.nodeTypedValue
                    End If
                    If oElement.nodeName = "Assessment" Then
                        If oElement.nodeTypedValue = "PASSED" Then
                            ActiveSheet.Cells(27, 13) = "Réussi"
                        Else
                            ActiveSheet.Cells(27, 13) = "Echec"
                        End If
                    End If
                Next oElement
            End If
        End If
        If Not oElement Is Nothing Then
         'on recupére les données du testTRP Si le noeud <Name>=1-TL2H
            If oElement.nodeName = "Name" And Right(oElement.nodeTypedValue, 4) = "TL2H" Then
                For Each oElement In oNode.ChildNodes
                    If oElement.nodeName = "Tnom" Then
                        ActiveSheet.Cells(28, 10) = oElement.nodeTypedValue
                    End If
                    ActiveSheet.Cells(28, 11) = "s"
                    If oElement.nodeName = "Tact" Then
                        ActiveSheet.Cells(28, 12) = oElement.nodeTypedValue
                    End If
                    If oElement.nodeName = "Assessment" Then
                        If oElement.nodeTypedValue = "PASSED" Then
                            ActiveSheet.Cells(28, 13) = "Réussi"
                        Else
                            ActiveSheet.Cells(28, 13) = "Echec"
                        End If
                    End If
                Next oElement
            End If
        End If
    Next oNode
End Sub

**tedo01** · 22/05/2012, 19h46

Re-bonjour,

Comme le traitement est le même pour les 6 noeuds, sauf pour la ligne où on recopie les donnée, il y a effectivement moyen de simplifier.
J'ai ajouté une variable intLigne qui permet de choisir la ligne en fonction du noeud, puis je n'ai gardé le traitement qu'une seule fois au lieu de 6, en remplaçant le numéro de ligne (23 à 28) par la variable lorsqu'on alimente des cellules :

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
Option Explicit
'test Réenclenchement
Sub Reenclencheur(xmlDoc As DOMDocument)
'Déclaration des variables
Dim oNode As IXMLDOMElement
Dim oElement As IXMLDOMElement
Dim oRoot As IXMLDOMElement
 
Dim i As Integer
Dim j As Integer
Dim fixe
Dim k As Byte
'Nom du noeud
Dim strType As String
'Ligne sur laquelle on doit recopier les informations
Dim intLigne As Integer
 
'éléments fixes
fixe = Array("TRP", "TL1P", "TL2P", "TRH", "TL1H", "TL2H")
For i = 23 To 28
    For j = 9 To 9
        With ActiveSheet
            .Cells(i, j).Value = fixe(k)
        End With
        k = k + 1
    Next j
    For j = 13 To 13
        ActiveSheet.Cells(i, j) = "NonRéalisé"
    Next j
Next i
'Pour extraire les éléments du cycle "Réenclencheur, on Boucle dans la balise <Seq_Measurement></Seq_Measurement>
  For Each oNode In xmlDoc.getElementsByTagName("Seq_Measurement")
      'on accéde à l'élément "Name"
        Set oElement = oNode.getElementsByTagName("Name")(0)
        If Not oElement Is Nothing Then
            strType = oElement.nodeTypedValue
            'on recupére les données du testTRP pour les noeud
            '<Name>=1-TRP (ligne 23), 1-TL1P (ligne 24), 1-TL2P (ligne 25), 1-TRH (ligne 26), 1-TL1H (ligne 27), 1-TL2H (ligne 28)
            If oElement.nodeName = "Name" And _
               (strType = "1-TRP" Or strType = "1-TL1P" Or strType = "1-TL2P" Or strType = "1-TRH" Or strType = "1-TL1H" Or strType = "1-TL2H") Then
                'Selon le noeud sur lequel on se trouve, choix de la bonne ligne pour copier les informations
                Select Case strType
                    Case "1-TRP":  intLigne = 23
                    Case "1-TL1P": intLigne = 24
                    Case "1-TL2P": intLigne = 25
                    Case "1-TRH":  intLigne = 26
                    Case "1-TL1H": intLigne = 27
                    Case "1-TL2H": intLigne = 28
                End Select
 
                For Each oElement In oNode.ChildNodes
                    If oElement.nodeName = "Tnom" Then
                        ActiveSheet.Cells(intLigne, 10) = oElement.nodeTypedValue
                    End If
                    ActiveSheet.Cells(intLigne, 11) = "s"
                    If oElement.nodeName = "Tact" Then
                        ActiveSheet.Cells(intLigne, 12) = oElement.nodeTypedValue
                    End If
                    If oElement.nodeName = "Assessment" Then
                        If oElement.nodeTypedValue = "PASSED" Then
                            ActiveSheet.Cells(intLigne, 13) = "Réussi"
                        Else
                            ActiveSheet.Cells(intLigne, 13) = "Echec"
                        End If
                    End If
                Next oElement
            End If
        End If
    Next oNode
End Sub

**gibba88** · 23/05/2012, 10h30

coucou .votre programme est parfait

.il marche bien .je vais essayer de l'adapter avec mes autres modules. franchement votre aide m'est d'une grande utilité. encore merci a vous

probléme pour recupération des dates d'un fichier xml sous VBA [XL-2007]

Macros et VBA Excel

Discussions similaires

Partager

Partager