XL 2010 Boucles imbriquées et fichier XML à géométrie variable

Twing83

XLDnaute Junior
Bonjour,
Je vais tenter de décrire mon problème le plus précisément possible pour ne pas faire perdre son temps à tous ceux qui voudront bien se donner la peine de se pencher sur ce sujet.
J'ai une collection de fichiers XML que je veux importer dans des feuille XLS, mais je bloque sur une partie des fichiers qui sont à géométrie variable.
- Un fichier XML peut contenir "n" <item classId="xx" IdNumber="x">
- Pour 1 <item classId="xx" IdNumber="x">, il peut y avoir jusqu'à 8 <divisionReport divisionId="xx"...
- Pour chaque <divisionReport divisionId="xx", il peut y avoir jusqu'à 4 <item subDivisionId="xx"...
Je souhaite importer les données dans une feuille XLS dont j'ai structuré les colonnes en conséquence, mais ça ne se passe pas comme je veux, bref je ne m'en sort pas !
Je joints les fichiers XML et mon fichier de test.
Votre aide sera précieuse...

XML:
<?xml version="1.0" encoding="ISO-8859-1" ?>
<data sessionId="001">
    <dataList>
        <item classId="259" IdNumber="1">
            <globalReport>
                <report>
                    <detailedReport System="ENGINE_FRONT_ID" State="OPERATIVE">
                        <syntheticDetailedReport>
                            <syntheticDetailedReport>
                                <divisionReport divisionId="11" minReturns="4011" returns="9011">
                                    <subDivisionList>
                                        <item subDivisionId="11" subDivisionType="FULL_THROTTLE" />
                                        <item subDivisionId="12" subDivisionType="FULL_THROTTLE" />
                                        <item subDivisionId="13" subDivisionType="FULL_THROTTLE" />
                                        <item subDivisionId="14" subDivisionType="FULL_THROTTLE" />
                                    </subDivisionList>
                                </divisionReport>
                                <divisionReport divisionId="12" minReturns="4012" returns="9012">
                                    <subDivisionList>
                                        <item subDivisionId="21" subDivisionType="REDUCED_THROTTLE" />
                                        <item subDivisionId="22" subDivisionType="REDUCED_THROTTLE" />
                                        <item subDivisionId="23" subDivisionType="REDUCED_THROTTLE" />
                                        <item subDivisionId="24" subDivisionType="REDUCED_THROTTLE" />
                                    </subDivisionList>
                                </divisionReport>
                            </syntheticDetailedReport>
                        </syntheticDetailedReport>
                    </detailedReport>
                </report>
            </globalReport>
        </item>
        <item classId="270" IdNumber="1">
            <globalReport>
                <report>
                    <detailedReport System="ENGINE_FRONT_ID" State="OPERATIVE">
                        <syntheticDetailedReport>
                            <syntheticDetailedReport>
                                <divisionReport divisionId="21" minReturns="4021" returns="9021">
                                    <subDivisionList>
                                        <item subDivisionId="111" subDivisionType="FULL_THROTTLE" />
                                        <item subDivisionId="121" subDivisionType="FULL_THROTTLE" />
                                        <item subDivisionId="131" subDivisionType="FULL_THROTTLE" />
                                        <item subDivisionId="141" subDivisionType="FULL_THROTTLE" />
                                    </subDivisionList>
                                </divisionReport>
                                <divisionReport divisionId="22" minReturns="4022" returns="9022">
                                    <subDivisionList>
                                        <item subDivisionId="212" subDivisionType="REDUCED_THROTTLE" />
                                        <item subDivisionId="222" subDivisionType="REDUCED_THROTTLE" />
                                        <item subDivisionId="232" subDivisionType="REDUCED_THROTTLE" />
                                        <item subDivisionId="242" subDivisionType="REDUCED_THROTTLE" />
                                    </subDivisionList>
                                </divisionReport>
                            </syntheticDetailedReport>
                        </syntheticDetailedReport>
                    </detailedReport>
                </report>
            </globalReport>
        </item>
    </dataList>
</data>
 

Pièces jointes

  • test_boucle.zip
    26.5 KB · Affichages: 10
Solution
pour les classid qui ne serait pas des item classid....
j'ai modifié la fonction
j'ai transformé la fonction getelementsbyattribut en getelementsbytagandattribut
comme ça elle collectionne que les éléments <item classId..."

comme ca il n'y aura pas d'ambiguité avec <datalist classId.... et< item classId ...
remplace le code du module
VB:
'*********************************************************
'xml parser designed by patricktoulon for twing83 on XLD
'version 2.0
'author patricktoulon
'*********************************************************
Option Explicit
Sub test()
Dim fichier As Variant, i&
    fichier = Application.GetOpenFilename("Text Files (*.xml), *.xml", 1, "ouvrir un fichier XML", , True)
    If Not...

Twing83

XLDnaute Junior
On est d'accord que Doc 1 commence ainsi ?

<?xml version="1.0" encoding="ISO-8859-1" ?>
<data sessionId="001">
<dataList>
<item classId="259" IdNumber="1">
<globalReport>
<report>
<detailedReport System="ENGINE_FRONT_ID" State="OPERATIVE">
<syntheticDetailedReport>
<syntheticDetailedReport>
<divisionReport divisionId="11" minReturns="4011" returns="9011">
<subDivisionList>
<item subDivisionId="11" subDivisionType="FULL_THROTTLE" />
<item subDivisionId="12" subDivisionType="FULL_THROTTLE" />
<item subDivisionId="13" subDivisionType="FULL_THROTTLE" />
<item subDivisionId="14" subDivisionType="FULL_THROTTLE" />
</subDivisionList>
</divisionReport>
<divisionReport divisionId="12" minReturns="4012" returns="9012">
<subDivisionList>
<item subDivisionId="21" subDivisionType="REDUCED_THROTTLE" />
<item subDivisionId="22" subDivisionType="REDUCED_THROTTLE" />
<item subDivisionId="23" subDivisionType="REDUCED_THROTTLE" />
<item subDivisionId="24" subDivisionType="REDUCED_THROTTLE" />
</subDivisionList>[/CODE]
 

patricktoulon

XLDnaute Barbatruc
et ben il sont comme ça dans le xml
le premier c'est bien 11 et le 2d c'est bien 121
c'est la ligne de titre qui t'induit en erreur je ne l'ai pas changé
1670709492972.png
 

Twing83

XLDnaute Junior
J'utilise ton code tel quel et j'obtiens me semble-t'il la même chose que toi...

1670737697978.png

re
ok tu lance la sub test
tu sélectionne tout tes fichiers xml en même temps dans le dialog et ...
Regarde la pièce jointe 1157524

En ne s'intéressant qu'à la colonne divisionId1 on observe qu'elle ne prend que 2 valeurs distinctes 12 & 22 correspondant respectivement aux deuxièmes <divisionReport... de chaque classId.
On est d'accord pour dire que nos résultats sont identiques (rassurant avec les mêmes données et même code) ou je fais illico un procès à mon ophtalmo qui vient de me faire refaire mes lunettes ;):)😊
 

Twing83

XLDnaute Junior
Bonjour @Twing83
j'ai carrément revue la chose dans son intégralité
4 divisons max par item ClassId et 4 sublistes par division soir 16 subdivision max par item ClassId
avec ça on est large me semble t -il
;)
Bonsoir Patrick,
Ça fonctionne !
J'avais besoin de 8 divisions par item ClassId et 4 subsistes par division mais je devrais m'en sortir (j'espère :) ) avec ta méthode.
Pour ma culture, que signifie la fin de la ligne (toutes les virgules)
VB:
 ligne = Array(sessionId, _
                      elemClassid(i).getattribute("classId"), _
                      elemClassid(i).getattribute("IdNumber"), _
                      Dtrep(0).getattribute("System"), _
                      Dtrep(0).getattribute("State"), , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , "")
 

patricktoulon

XLDnaute Barbatruc
bon il a fallu modifier certaines petites choses mais voilà
8 division max par item classId et 4 subdivision par division
j'ai modifié un xml pour les tests (j'ai mis 8 division dans un item classId )
voila maintenant c'est perfect !!
;)
 

Pièces jointes

  • test xml_parse V3.0 .zip
    23.4 KB · Affichages: 2

patricktoulon

XLDnaute Barbatruc
je reconnais aisément que l'array avec les virgules ça faisait un peu brouillon 😂

maintenant c'est propre l'array est redimé a chaque ligne sur 200 colonne (au cas ou tu voudrais ajouter + de 8 divisions
le tableau a été modifé aussi afin de recevoir les eventuels division (8 max)
bref c'est clé en main ;)
 

Twing83

XLDnaute Junior
Super...Au top 👏
J'essaie d'adapter ton code à mes fichiers originaux et je m'aperçois que j'ai zappé une information très importante... :mad:
Mes fichiers XML contiennent plusieurs dizaines de <xxxList> avant mon fameux <dataList> et comme si ça n'était pas assez drôle le classId est présent dans presque chacune de ces <xxxList>.
Ca remet en cause elemClassid = GetElementsByAttributs(objxml, "classId")
 

patricktoulon

XLDnaute Barbatruc
pour les classid qui ne serait pas des item classid....
j'ai modifié la fonction
j'ai transformé la fonction getelementsbyattribut en getelementsbytagandattribut
comme ça elle collectionne que les éléments <item classId..."

comme ca il n'y aura pas d'ambiguité avec <datalist classId.... et< item classId ...
remplace le code du module
VB:
'*********************************************************
'xml parser designed by patricktoulon for twing83 on XLD
'version 2.0
'author patricktoulon
'*********************************************************
Option Explicit
Sub test()
Dim fichier As Variant, i&
    fichier = Application.GetOpenFilename("Text Files (*.xml), *.xml", 1, "ouvrir un fichier XML", , True)
    If Not IsArray(fichier) Then
        If fichier = False Then Exit Sub
        fichier = Array(fichier)
    End If
    For i = LBound(fichier) To UBound(fichier)
        parser fichier(i)
    Next
End Sub

Sub parser(fichier)
Dim ligne, objxml, sessionId$, elemClassid, elem, i&, c&, x&, z&, Q&, a&, Dtrep, Division, Subdivision
    Set objxml = CreateObject("Msxml2.DOMDocument")
    objxml.async = False: objxml.validateOnParse = False
    objxml.Load fichier
     sessionId = objxml.getelementsbytagname("data")(0).getattribute("sessionId")
    elemClassid = GetElementsByTagAndAttributs(objxml, "item", "classId")
    For i = 0 To UBound(elemClassid)
    ReDim ligne(0 To 200)
     Set Dtrep = elemClassid(i).getelementsbytagname("detailedReport")
        Set Division = elemClassid(i).getelementsbytagname("divisionReport")
        ligne(0) = sessionId
        ligne(1) = elemClassid(i).getattribute("classId")
        ligne(2) = elemClassid(i).getattribute("IdNumber")
        ligne(3) = Dtrep(0).getattribute("System")
        ligne(4) = Dtrep(0).getattribute("State")
        x = 5
        For a = 0 To Division.Length - 1
            ligne(x) = Division(a).getattribute("divisionId")
            ligne(x + 1) = Division(a).getattribute("minReturns")
            ligne(x + 2) = Division(a).getattribute("returns")
            z = x + 2
            Set Subdivision = Division(a).getelementsbytagname("item")
            For Q = 0 To Subdivision.Length - 1
                ligne(z + 1) = Subdivision(Q).getattribute("subDivisionId")
                ligne(z + 2) = Subdivision(Q).getattribute("subDivisionType")
                z = z + 2
            Next
            x = x + 11
        Next
        Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(, UBound(ligne) + 1) = ligne
    Next
    Columns("A:z").AutoFit
End Sub

Function GetElementsByTagAndAttributs(obj, tags, attribut)
Dim elements, elem, tbl(), a&
    Set elements = obj.getelementsbytagname("*")
    For Each elem In elements
        On Error Resume Next
        If elem.tagname = tags And elem.getattribute(attribut) Then
            ReDim Preserve tbl(0 To a): Set tbl(a) = elem: a = a + 1
            Err.Clear
        End If
    Next
    GetElementsByTagAndAttributs = tbl
End Function
 

Twing83

XLDnaute Junior
Bonsoir Patrick,
C'est parfait, tout marche nickel !
J'ai eu le temps aujourd'hui de réadapter ton code à mes fichiers complets, c'est tout simplement parfait... 👏
Il ne me reste plus qu'à sortir le sessionId de la 1ère boucle (For i = 0 To UBound(elemClassid)) pour avoir le résultat escompté.
Un très grand merci à toi, tu as résolu le problème qui me bloquait depuis presque 2 semaines et qui me rendait hystérique...