probleme pour traitement de fichier xml en vba, lenteurs

**newcodeur** · 04/09/2008, 10h16

Bonjour,
voici mon pbm :
je dois importer plusieurs fichiers xml, ( selecetion des valeurs pour les balises voules puis mise en forme dans des feuilles excel).
j'arrive à les importer mais le pbm est que le temps de traitement des fichiers pour qu'ils soient importer dans excel est extremement long.
pour indication je suis passer d'une minute pour extraire les données d'un fichier pour les stocker dans une feuille excel à 3 secondes.
mais le pbm est que c tj long plus je rajoute des fichiers + c long.
j'ai tout tenter j'ai meme essayé Xpath, les fonctions de raffraichissment de l'écran mais tj rien.

Est-ce qu'il est possible que le vba bne soit pas adapté au traitement de fichiers XML???

Quelqu'un a-til une idée? pour que le traitement s'effectue plus rapidement.
peut-être j'ai juste oublié une fonction qui va me permettre de gagner du temps.

Ou peut-etre que ce sont les if qui me font perdre du temps????

Je vous envois la fonction qui permet de l'importation( Parseur).

je vous envois des exemples de fichier XML pour voir leurs structures

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
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
 
 
'************************************************************************************
'********fonction pour l'importation des fichiers XML********************************
'************************************************************************************
 
Sub IMPORT_XML_File_lister(fichier As String)
 
 
 
'Déclaration des  Variables et des objets  DOMXML
 
Dim ParsDoc As MSXML2.DOMDocument
 
Dim ListeEnfants_de_md As MSXML2.IXMLDOMNodeList
Dim ListeEnfants_de_mi As MSXML2.IXMLDOMNodeList
Dim ListeEnfants_de_mv As MSXML2.IXMLDOMNodeList
Dim Liste_md As MSXML2.IXMLDOMNodeList
 
Dim Noeud_mi As MSXML2.IXMLDOMNode
Dim Noeud_mts As MSXML2.IXMLDOMNode
'Dim Noeud_gp As MSXML2.IXMLDOMNode
Dim Noeud_mt As MSXML2.IXMLDOMNode
Dim Noeud_mv As MSXML2.IXMLDOMNode
Dim Noeud_moid As MSXML2.IXMLDOMNode
Dim Noeud_r As MSXML2.IXMLDOMNode
Dim Noeud_md As MSXML2.IXMLDOMNode
 
'**********noeud de la ligne 3***************
'Dim Noeud_line3   As String
'Dim Noeud3 As MSXML2.IXMLDOMDocumentType
'Dim Noeud3 As MSXML2.IXMLDOMNotation
 
'Dim N3 As MSXML2.IXMLDOMNode
'*****************************************
 
 
 
 
 
Dim Enfants_de_md As MSXML2.IXMLDOMNode
Dim Enfants_de_mi As MSXML2.IXMLDOMNode
Dim Enfants_de_mv As MSXML2.IXMLDOMNode
 
 
Dim racine_mdc As MSXML2.IXMLDOMNode
 
Dim Objet_Erreur As MSXML2.IXMLDOMParseError
 
Dim intI As Integer, intK, intL, intR, intMT
 
Dim date_mts As String, date_ok
 
Dim Nom_moid As String
'Dim file_xml As String
Dim objet_node As String
Dim data As String
 
'permet de ne pas voir se qui se passe
Application.ScreenUpdating = False
Application.DisplayAlerts = False
 
 
 
'Pour nettoyer les cellules à chaque renouvellement du programme
'Worksheets("IMPORT_XML").Activate
'Cells.ClearContents
 
 
'file_xml = Worksheets("Sheet3").Cells(15, 5).Value
' mettre en commentaire la ligne du dessus, puis mettre en argument de la fonction.
 
 
 
 
'Initialisation du Parseur
'la fonction permet de faire la référence entre la variable et le DOC_XML
Set ParsDoc = New MSXML2.DOMDocument
 
 
 
 
 
'Chargement du Document de manière synchrone
ParsDoc.async = False
 
 
 'pour que le fichier xml soit charger correctement
 'on  définit qu'il ne va pas valider la structure des données
 ' mettre le DTD dans le même répertoire que les fichiers XML.
 ParsDoc.validateOnParse = False
 
'on charge le document en mémoire
 
'***********************pour ne pas avoir le msgbox***************
ParsDoc.Load (fichier)
'*****************************************************************
 
 
'If ParsDoc.Load(fichier) Then
 
        'MsgBox "Document XML correctement chargé"
   ' Else
 
'****************************supression de la ligne 3 des XML Files*************************
'MsgBox "Erreur de lecture du document XML"
 
'Dim line3 As String
'Dim nbcaracline3 As Long
'Dim remplace As String
'Dim l3 As String
 
 
 
 
 '********************************TRAITEMENT DU FICHIER XML*********************************
 
 Set racine_mdc = ParsDoc.documentElement
 
 
 For Each Noeud_md In racine_mdc.childNodes
 
  If Noeud_md.nodeName = "md" Then
 
 Set ListeEnfants_de_md = Noeud_md.childNodes
 
 
            For Each Noeud_mi In ListeEnfants_de_md
            If Noeud_mi.nodeName = "mi" Then
            '*******************************Création d'une nouvelle feuille******************
            Worksheets.Add After:=Worksheets("IMPORT_XML")
           '****************************************************************************
           ActiveSheet.Cells(4, 1) = "Measurement Times"
           ActiveSheet.Cells(4, 2) = "Suspect values"
 
            ActiveSheet.Cells(4, 3) = "MOID"
            ActiveSheet.Cells(4, 4) = "COMPTEURS"
 
           Range("A4").Font.Bold = True
           Range("B4").Font.Bold = True
           Range("B4").Font.ColorIndex = 3
           Range("C4").Font.Bold = True
           Range("D4").Font.Bold = True
 
 intI = 7
 intK = 4
 intL = 7
 intR = 4
 intMT = 5
 
 'intrr = 6
 
 
 
 
 
 
            Set ListeEnfants_de_mi = Noeud_mi.childNodes
 
                    For Each Enfants_de_mi In ListeEnfants_de_mi
            'je peux incrémenter intR ici
            'intR = 3
                        If Enfants_de_mi.nodeName = "mts" Then
                        'ActiveSheet.Cells(intI, 1).Value = Enfants_de_mi.nodeTypedValue
                        date_mts = Enfants_de_mi.nodeTypedValue
                        date_ok = Mid(date_mts, 1, 8) + " " + Mid(date_mts, 9, 2) + "h" + Mid(date_mts, 11, 2) + "mn"
                        ActiveSheet.Cells(intI, 1).Value = date_ok
 
                        End If
 
                        If Enfants_de_mi.nodeName = "mt" Then
                         ActiveSheet.Cells(intMT, intK).Value = Enfants_de_mi.nodeTypedValue
                        intK = intK + 1
                        End If
 
                    'mettre en commentaire la fonction du dessous me fait gagner 5 sec/feuille xml
                      'ActiveSheet.Columns.AutoFit
 
                                If Enfants_de_mi.nodeName = "mv" Then
 
                                Set Noeud_mv = Enfants_de_mi
 
                                Set ListeEnfants_de_mv = Noeud_mv.childNodes
 
                               '******************************************
 
                                    For Each Enfants_de_mv In ListeEnfants_de_mv
 
                                            If Enfants_de_mv.nodeName = "moid" Then
                                             ActiveSheet.Cells(intL, 3).Value = Enfants_de_mv.nodeTypedValue
                                             'intL = intL + 4
                                             intL = intL + 1
 
                                            End If
 
                                            If Enfants_de_mv.nodeName = "r" Then
                                            'ActiveSheet.Cells(intL - 4, intR).Value = Enfants_de_mv.nodeTypedValue
                                            ActiveSheet.Cells(intL - 1, intR).Value = Enfants_de_mv.nodeTypedValue
                                            intR = intR + 1
                                            End If
 
                                    '**************balise indiquant un fichier faux************
                                    If Enfants_de_mv.nodeName = "sf" Then
                                    'ActiveSheet.Cells(intL - 4, 1).Value = Enfants_de_mv.nodeTypedValue
                                    ActiveSheet.Cells(intL - 1, 2).Value = Enfants_de_mv.nodeTypedValue
                                    Cells(intL - 1, 2).Font.ColorIndex = 3
                                    'Rows(intL).Interior.Color = 3
 
                                    End If
                                    '****************************************************************
                                'mettre en commentaire la fonction du dessous me fait gagner 5 sec/feuille xml
                                   'ActiveSheet.Columns.AutoFit
 
                                    Next Enfants_de_mv
 
                                    '**********on reset  intR sur la ligne du dessous***********
                                    intR = 4
                                    '***************************************************************
                                End If
 
                    'pb quand on a fini la boucle dans les noeudenfant_mv on reste toujours sur le meme noeud_mi
                    Next Enfants_de_mi
 
                    intMT = intMT + 1
 
            End If
            Next Noeud_mi
 
 
    End If
 
    '*************test 1 du moid pour créer les feuilles avec le moname****************
 
Set ParsDoc = Nothing
 
'Set racine_mdc = Nothing
'Set ListeEnfants_de_md = Nothing
'Set ListeEnfants_de_mi = Nothing
'Set ListeEnfants_de_mv = Nothing
'Set Liste_md = Nothing
'Set Enfants_de_md = Nothing
'Set Enfants_de_mi = Nothing
'Set Enfants_de_mv = Nothing
 
'Set Objet_Erreur = Nothing
 
'Set Noeud_md = Nothing
'Set Noeud_mi = Nothing
'Set Noeud_mts = Nothing
'Set Noeud_gp = Nothing
'Set Noeud_mt = Nothing
'Set Noeud_mv = Nothing
'Set Noeud_moid = Nothing
'Set Noeud_r = Nothing
 
 Next Noeud_md
 
 '******************test 2 du moid pour créer les feuilles avec le moname**************
 
 
 
'********************************FIN TRAITEMENT FICHIER XML*****************************
 
'****************Fonctions permettant de décharger les objets instanciés****************
 
 
 
 
 
'****************normalement pour vider la memoire des dom xml c'est ici
' j'ai modifié pour l'optim
 
 
'Set Noeud_line3 = Nothing
 
' on reactive la méthode
'Application.ScreenUpdating = True
Application.DisplayAlerts = True
 
End Sub

**Godzestla** · 04/09/2008, 17h12

Salut,

j'ai juste survolé, car je ne connais rien au xml.

Ton code peux déjà tourné plus vite si tu remplaces certains if par select

Ex :

Code :

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

1
2
3
4
5
6
7
8
 
If Enfants_de_mi.nodeName = "mts" Then
..
Endif
 
If Enfants_de_mi.nodeName = "mt" Then
..
Endif

Mieux vaut :

Code :

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

1
2
3
4
5
 
Select case Enfant_de_mi.nodeName
  case "mts"
  case "mt"
end select

Avec select le test s'arrete au premier matching, donc moins de test.
Mais idéalement, il faut placer les tests dans l'ordre décroissant de probabilité.

Bon amusement.

probleme pour traitement de fichier xml en vba, lenteurs

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager