Optimisation d'un code en vba pour traitement de fichier xml (entrés/sorties)

Signaler
Messages postés
25
Date d'inscription
lundi 11 décembre 2000
Statut
Membre
Dernière intervention
1 juillet 2008
-
Messages postés
25
Date d'inscription
lundi 11 décembre 2000
Statut
Membre
Dernière intervention
1 juillet 2008
-
Bonjour , je voudrais savoir si il est possible en vba de créer des
structures ou des listes chainées et si oui commentle faire , car je
dois exploiter des fichiers xml et cela me prend trop de temps en
utilisant une méthode avec un parseur qui analyse mon fichier xml et
récupère les données dans mes balises souhaitées pour les recopier dans
des feuilles excel.


je suis débutant et j'ai vu qu'on pouvait optimiser un code en
utilisant des listes ou structures qui travaille sur la mémoire
directement au lieu de travailler avec des variables qui travaillent
sur le disque dur.


Merci de votre aide.

5 réponses

Messages postés
17286
Date d'inscription
mercredi 2 janvier 2002
Statut
Modérateur
Dernière intervention
23 décembre 2019
69
tu passes par un parseur XML maison ?

pourquoi ne pas utiliser le DOM ?
Messages postés
25
Date d'inscription
lundi 11 décembre 2000
Statut
Membre
Dernière intervention
1 juillet 2008

j'utilise le DOM mais c'est qu'ubn fichier XML pèse 600ko et je dois en traiter 96
hier j'ai fais un test
pour un fichier sa me prend 6-7s mais pour 48 fichiers sa m'a pris 25 min !!!!

j'ai créer mon code à partir de site suivant :
http://www.laltruiste.com/document.php?page=1&rep=8

voici le code :

Sub IMPORT_XML_File()

'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 à supprimer...***************
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
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

'Pour nettoyer les cellules à chaque renouvellement du programme
'Worksheets("IMPORT_XML").Activate
'Cells.ClearContents

file_xml = Worksheets("Sheet1").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
 

'on charge le document en mémoire

If ParsDoc.Load(file_xml) Then

        MsgBox "Document XML correctement chargé"
    Else
     
'****************************supression de la ligne 3 des XML Files...*************************
'Noeud_line3 = ParsDoc.Xml
'MsgBox (Noeud_line3)
'MsgBox (objet_node)
 'data = "<!DOCTYPE mdc SYSTEM "MeasDataCollection.dtd">"
 
 'Set Noeud3 = ParsDoc.createCDATASection(<![DOCTYPE mdc SYSTEM ["MeasDataCollection.dtd"]]>)
 
 
 'data = Noeud3.baseName

 'Set Noeud3 = ParsDoc.doctype
 
  'data = Noeud3.nodeTypedValue
 

 
'MsgBox (data)
'********************************************************************************************
      
        
        
          MsgBox "Erreur de lecture du document XML"
         
         
'                           ****************************
'    ******************Partie concernant la gestion des erreurs**********************
         
   'instancier le fichier xml pour la gestion des erreurs
Set Objet_Erreur = ParsDoc.parseError
         
         
' contient le code de l'erreur da la dernière erreur d'analyse, en lecture seule.
code = Objet_Erreur.errorCode
MsgBox (code)
         
         
'fournit une explication à propos de l'erreur, en lecture seule.
 raison = Objet_Erreur.reason
 MsgBox (raison)

'contient la position du fichier absolue où l'erreur s'est produite, en lecture seule.
position_fichier = Objet_Erreur.filepos
MsgBox (position)

'spécifie le numéro de la ligne contenant l'erreur, en lecture seule.
 position_ligne = Objet_Erreur.Line
 MsgBox (position_ligne)
 
 
 'contient la position du caractère à l'intérieur de la ligne où l'erreur s'est produite, en lecture seule.
 Position_carac_ligne = Objet_Erreur.linepos
 MsgBox (Position_carac_ligne)
 
 'retourne le texte complet de la ligne contenant l'erreur, en lecture seule.
 chaine = Objet_Erreur.srcText
 MsgBox (chaine)
 
 'contient l'adresse URL du document XML contenant la dernière erreur, en lecture seule.
 adr_url = Objet_Erreur.URL
 MsgBox (adr_url)
  
 '                      ****************************************
     
    End If

'***************************FONCTIONS GESTION DES ERREURS*******************************

'Quand on instancie la gestion des erreurs il faut déclarer l'objet juste avant les méthodes
'Ce n'est pas nécessaire de déclarer les varaibles pour la gestion des erreurs
'mais c'est recommandé

' lorsque je supprime la ligne 3 qui contient ceci
' <!DOCTYPE mdc SYSTEM "MeasDataCollection.dtd">
' le document est correctement charger.

 
 
 '******************************FIN GESTION DES ERREURS********************************
 
 
 '*****************************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) = "MOID"
            ActiveSheet.Cells(4, 3) = "COMPTEURS"
           
           'Range("B4").HorizontalAlignment = xlCenter
           Range("A4").Font.Bold = True
           Range("B4").Font.Bold = True
           Range("C4").Font.Bold = True
          
          
 intI = 5
 intK = 3
 intL = 7
 intR = 3
 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
                        End If
                       
                        If Enfants_de_mi.nodeName = "mt" Then
                         ActiveSheet.Cells(intMT, intK).Value = Enfants_de_mi.nodeTypedValue
                        intK = intK + 1
                        End If
           
           
                      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, 2).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, 1).Value = Enfants_de_mv.nodeTypedValue
                                    End If
                                    '****************************************************************
                                   
                                   ActiveSheet.Columns.AutoFit
                                    Next Enfants_de_mv
                                  
                                    '**********on reset  intR sur la ligne du dessous***********
                                    intR = 3
                                    '***************************************************************
                                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
 Next Noeud_md
 

 
'********************************FIN TRAITEMENT FICHIER XML*****************************
 
'****************Fonctions permettant de décharger les objets instanciés****************

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
'Set Noeud_line3 = Nothing

' on reactive la méthode
Application.ScreenUpdating = True

End Sub
Messages postés
25
Date d'inscription
lundi 11 décembre 2000
Statut
Membre
Dernière intervention
1 juillet 2008

je t'envois un fichier XML si tu ve ????
Messages postés
17286
Date d'inscription
mercredi 2 janvier 2002
Statut
Modérateur
Dernière intervention
23 décembre 2019
69
6-7 secondes, c'est sacrément long...

...

y'a beaucoup de variables, certes, mais bon...
coté code, rien ne m'a sauté aux yeux
Messages postés
25
Date d'inscription
lundi 11 décembre 2000
Statut
Membre
Dernière intervention
1 juillet 2008

Est-ce qu'il ne serait pas possible d'utiliser une autre méthode par exemple garder les valeurs de mon fichier en mémoire dans des structures ou des liste chainées ???
je ne sais pas si c'est possible en vba???

parce que la mon code récupère l' info et il l'a copie directement dans mon fichier excel un ami m'a dit que sa  prend plus de temps de cette manière que si le prog conservé les valeurs dans une variable pour ne les recopier qu'une fois tout mon fichier traiter?