XML, récupération de données du noeud précédent en VBA

Bonjour à vous,

Voilà mon soucis : je dois automatiser la recherche d'informations contenues dans des fichiers .xml avec VBA. Une des données à récupérer se trouve dans un noeud particulier (dont je connais le nom : "MOTIF") situé juste avant un autre noeud contenant une information me permettant de le localiser (Ce second noeud se nomme "NATTRV" est contient une chaine de caractère particulière : "NTI3"). Donc les 2 noeuds n'ont pas le même nom mais j'ai besoin de l'un pour situer l'autre. J'arrive sans soucis à trouver le 2nd noeud mais le soucis c'est pour extraire l'autre information. En effet leurs positions ne sont absolument pas liées. Par exemple "NATTRV" peut être la seconde occurence quand le "MOTIF" correspondant est le 8ème... C'est plus ou moins aléatoire, et ça ne dépend que de la façon dont est rempli le fichier .xml, mais celui qui m'intéresse se retrouve toujours dans la même situation.

Je précise quand même que je n'ai que les droits en lecture de ce fichier, donc impossible à modifier. De plus, le fichier .xml fait plusieurs centaines de lignes et peut contenir quelques informations que je ne peux pas divulguer ici

Voici mon code pour l'instant :

champ = "Inconnu" 'Il est possible de ne pas trouver l information
For i = 0 To oXmlDoc.SelectNodes("//NATTRV/text()").Length - 1 'On liste tous les noeud "NATTRV"
    If InStr(1, oXmlDoc.SelectNodes("NATTRV/text()")(i).NodeValue, "NTI3", 1) <> 0 Then 'Si on trouve la chaine "NTI3" on récupère la valeur du noeud "MOTIF" qui précède
        champ = oXmlDoc.SelectNodes("//MOTIF/text()")(i).NodeValue 'ici je ne récupère pas la bonne information du coup
        Exit For 'Si l'information est trouvée, on sort du FOR
    End If
Next i

J'espère avoir été le plus clair possible et je vous remercie d'avance pour l'aide que vous pourrez me fournir !

Bonjour,

ceci permet de récupérer séquentiellement toutes les balises

Sub test()
    Set xmlDoc = CreateObject("Microsoft.XMLDOM")
    xmlDoc.LoadXML codeSource(Range("A1"))
    Set tags = xmlDoc.getelementsbytagname("*")
    For Each myTag In tags
        Debug.Print myTag.tagname, myTag.Text
    Next
End Sub

Function codeSource(url) As String
    Dim xmlfile As Object
    Set xmlfile = CreateObject("microsoft.xmlhttp")
    With xmlfile
        .Open "get", url, False
        .send
        If .Status = 200 Then codeSource = .responsetext
    End With
End Function

à partir de là, en mémorisant la balise -1, tu dois alors pouvoir accéder à l'info

Merci Steelson pour ta réponse

J'ai testé ton code mais ça n'a pas l'air de bien fonctionner chez moi...

En plus je me suis rendu compte que pas mal de fichiers ont un ou deux noeuds entre les 2 qui m'intéressent, des fois ils contienent des choses, des fois ils sont vides... bref un vrai bordel... Voici un exemple pour montrer un peu à quoi ça peut ressembler dans la très grande majorité des cas:

...
...
<MOTIF> INFORMATION A RECUPERER </MOTIF>
<FIT> que du blabla </FIT>
<CDNATTRV/>
<NATTRV>... NTI3 ...</NATTRV>
...
...

Donc la première fois que je rencontre "NTI3" dans <NATTRV>, je dois récupérer ce qui est écrit dans le noeud <MOTIF> qui précède

Je ne l'ai pas précisé avant mais j'ai environ 1500 fichiers comme ça à traiter, avec à chaque fois une vingtaine d'info à sortir (pour les autres infos je n'ai pas de soucis particuliers )

Mais ton idée m'en a donné une autre, je teste ce que je peux avant ma débauche, si j'y arrive avant, je poste la solution trouvée, sinon demain

Merci en tout cas !

On peut mettre à plat complètement le xml et ensuite y naviguer, si les données ne sont pas trop volumineuses. Ou obtenir la liste des balises par une fonction non pas linéaire comme je l'ai faite, mais récursive. Si tu avais un fichier bidon représentatif cela pourrait aider.


On peut aussi utiliser Google Sheets qui peut être plus adapté à ce genre d'exercice. Le langage de requête XPath prend en compte les antécédents. Et ton fichier xml a forcément une "certaine" logique.

Je suppose que les informations que tu cherches sont relatives à un même "nœud ancêtre" mais font partie de 2 "nœuds frères" qui sont CDNATTRV et NATTRV ! mais avec une profondeur différente, genre :

capture d ecran 512

Dans ce cas le XPath pourrait être

//NATTRV | //NATTRV/../CDNATTRV/MOTIF

et donc la formule Google Sheets (à tester)

=importxml( url ; "//NATTRV | //NATTRV/../CDNATTRV/MOTIF" )

Justement, les fichiers peuvent faire 50 comme 500 lignes, c'est presque aléatoire... En tout cas il y a une liste d'une dizaine de balise qui reviennent et d'où j'extrait les informations, certaines sont simples à repérer, j'ai notamment des informations dans la première balise portant un certain nom, d'autres infos dans la dernière, ou avant dernière etc...

Les balises sont effectivement "cousines" comme tu le décrit, quoi que j'ai un doute sur certains fichiers, à savoir si elle ne serait pas des "clones" : elles ont le même nom et sont issues d'un même parents, je vérifierai ça demain matin.

J'ai cependant un fichier que je rend bidon ici pour montrer vraiment à quoi ça peut ressembler :

<LIM DATE="DATE DE CREATION">
<PIECE>
    <INFO>
        <IDENT>
        <MODIFS>
        <RENSPART>
        <ENSSUP>
        <INTERV>
            <PARAS>
                <ACTHH>
                    <ACTMSHH>TEMPS</ACTMSHH>
                </ACTHH>
            </PARAS>
            <DATFIN>DATE</DATFIN>
            <HRFIN>HEURE</HRFIN>
            <CDUNIT/>
            <CODMOTIF>NUMERO</CODMOTIF>
            <MOTIF>NON INTERESSANT ICI</MOTIF>
            <CDNATTRV/>
            <NATTRV/>
            <FRMTRV/>
            <PARAS>
                <ACTHH>
                    <ACTMSHH>TEMPS</ACTMSHH>
                </ACTHH>
            </PARAS>
            <DATFIN>DATE</DATFIN>
            <HRFIN>HEURE</HRFIN>
            <CDUNIT>PAS UTILE</CDUNIT>
            <CODMOTIF>PAS UTILE NON PLUS</CODMOTIF>
            <MOTIF>PAS UTILE DANS CE CAS</MOTIF>
            <FIT>NUMERO</FIT>
            <CDNATTRV/>
            <NATTRV>INFORMATION NON UTILE</NATTRV>
            <FRMTRV>NUMERO</FRMTRV>
            <CTRCLI>NOM</CTRCLI>
            <PARAS>
                <ACTHH>
                    <ACTMSHH>TEMPS</ACTMSHH>
                </ACTHH>
            </PARAS>
            <DATFIN>DATE</DATFIN>
            <HRFIN>HEURE</HRFIN>
            <CDUNIT>PAS UTILE</CDUNIT>
            <CODMOTIF>PAS UTILE NON PLUS</CODMOTIF>
            <MOTIF/>
            <FIT>NUMERO</FIT>
            <CDNATTRV/>
            <NATTRV/>
            <FRMTRV/>
            <PARAS>
                <ACTHH>
                    <ACTMSHH>TEMPS</ACTMSHH>
                </ACTHH>
            </PARAS>
            <DATFIN>DATE</DATFIN>
            <HRFIN>HEURE</HRFIN>
            <CDUNIT>PAS UTILE</CDUNIT>
            <CODMOTIF/>
            <MOTIF>CE QUE JE CHERCHE EST LA PAR EXEMPLE</MOTIF>
            <FIT>NUMERO</FIT>
            <CDNATTRV>NUMERO</CDNATTRV>
            <NATTRV>LA CHAINE "NTI3" EST PRESENTE ICI</NATTRV>
            <FRMTRV/>
            <CTRIND>NOM</CTRIND>
            <PARAS>
                <ACTHH>
                    <ACTMSHH>TEMPS</ACTMSHH>
                </ACTHH>
                <GARANTIE>
                    <GRHH>AN</GRHH>
                        </GARANTIE>
                        <GARANTIE>
                            <GRSTK>AN</GRSTK>
                        </GARANTIE>
            </PARAS>
    </INTERV>
    <PARAS>
        <ACTHH>
            <ACTMSHH>TEMPS/ACTMSHH>
        </ACTHH>
        <GARANTIE>
            <GRHH>AN</GRHH>
        </GARANTIE>
        <GARANTIE>
            <GRSTK>AN</GRSTK>
        </GARANTIE>
    </PARAS>
</INFO>
</PIECE>
</LIM>

Donc voilà, j'en ai recopié un petit pour pouvoir travailer depuis chez moi (la recopie à la main c'est pas top top, mais c'est déja ça). Je précise aussi qu'il y a des balises non fermées ici, c'est juste que j'ai fais un copié collé et que je n'ai pas développé certaines d'entre elles.

Mon idée était effectivement d'utiliser la récursivité afin de bien tout lister, j'ai commencé tout à l'heure et je reprends demain !

Malheureusement, VBA m'est imposé, on peut donc oublier tout autre moyen...

supprimé, pas pertinent

Voici une solution ...

je cherche le cheval gagnant dans cette course (je précise que je ne suis pas turfiste pour 2 sous)

image

les infos sont rangArrivee et nomCheval (situé avant et à un niveau différent)

Sub test()

    Dim xmlDoc      As MSXML2.DOMDocument60
    Dim xmlNodeList As MSXML2.IXMLDOMNodeList
    Dim xmlNode     As MSXML2.IXMLDOMNode
    Dim myNode      As MSXML2.IXMLDOMNode

    Set xmlDoc = New MSXML2.DOMDocument60
    xmlDoc.async = False

    Dim strPathToXMLFile As String
    strPathToXMLFile = Range("A1").Value
    xmlDoc.validateOnParse = True

    If Not xmlDoc.Load(strPathToXMLFile) Then
        MsgBox "Problème !"
        Exit Sub
    End If

    Set xmlNodeList = xmlDoc.getElementsByTagName("*")
    For Each xmlNode In xmlNodeList
        For Each myNode In xmlNode.ChildNodes
            If myNode.nodeName = "rangArrivee" Then
                If myNode.Text = 1 Then
                    Debug.Print myNode.nodeName, myNode.Text
                    For Each subNode In myNode.ParentNode.ParentNode.ChildNodes
                        If subNode.BaseName = "nomCheval" Then
                            Debug.Print subNode.BaseName, subNode.Text
                            MsgBox subNode.Text
                        End If
                    Next
                End If
            End If
        Next myNode
    Next xmlNode
End Sub
98exemple-xml.xlsm (17.95 Ko)

Explication :

j'explore tous les nodes

quand je trouve celui que je veux

myNode.nodeName = "rangArrivee"

et qui correspond aux critères

If myNode.Text = 1

alors j'explore les "enfants" du "grand-père"

For Each subNode In myNode.ParentNode.ParentNode.ChildNodes

jusqu'à trouver celui que je cherche

If subNode.BaseName = "nomCheval"

et qui me donne la valeur voulue

subNode.Text
    Set xmlNodeList = xmlDoc.getElementsByTagName("*")
    For Each xmlNode In xmlNodeList
        For Each myNode In xmlNode.ChildNodes
            If myNode.nodeName = "rangArrivee" Then
                If myNode.Text = 1 Then
                    Debug.Print myNode.nodeName, myNode.Text
                    For Each subNode In myNode.ParentNode.ParentNode.ChildNodes
                        If subNode.BaseName = "nomCheval" Then
                            Debug.Print subNode.BaseName, subNode.Text
                            MsgBox subNode.Text
                        End If
                    Next
                End If
            End If
        Next myNode
    Next xmlNode

Bonjour !

Alors voilà, j'ai pu tester ma solution et elle fonctionne exactement comme je le souhaite !

Voici ma solution si ça peut aider quelqu'un :

EDIT : ajout d'une ligne pour afficher un champ vide si l'info n'est pas trouvée dans le document

Function Recherche_Info (chemin As String, champ As String) as String 'L objectif est de mettre la valeur recherchée dans une cellule particulière
    Dim doc As DOMDocument
    Set doc = New DOMDocument
    doc.Load chemin

    Dim n As IXMLDOMNode
    Set n = doc.DocumentElement
    Call Affiche_Texte(n, champ)
    main = champ

End Function

Function Affiche_Texte(n As IXMLDOMNode, champ As String)
    If n.ChildNodes.Length = 0 Then Exit Function
    Dim xNode As IXMLDOMNode
    For Each xNode In n.ChildNodes
        If xNode.nodeName = "MOTIF" Then
            champ = xNode.Text    'On enregistre cette valeur comme ça dès qu'on atteint le mot clé dans le noeud <NATTRV> qui suit, on a bien le bon texte
        End If
        If xNode.nodeName = "NATTRV" Then
            If InStr(1, xNode.Text, "NTI3", 1) = 0 Then 
                champ = " " 'Si on trouve pas, on laisse la case vide
            Else
                Exit Function 'Dès que ce mot est trouvé, on sort et on passe à la suite
            End If
        End if
        Call Affiche_Texte(xNode, champ)
    Next
End Function

Malheureusement, je ne peux pas partager mon résultat pour montrer à quoi ça ressemble mais je suis assez content du résultat

Merci pour ton aide en tout cas, je testerai ton idée aussi pour voir laquelle conviendrai le mieux !

Bravo !

J'avais suivi le même parcours au départ, à savoir stocker la valeur de nomCheval au cas où je rencontrerais ensuite le rangArrivee voulu

Mais je me suis dit quand même que je voudrais être certain qu'il s'agit bien de la même "entité" ! et donc une fois le rang 1 trouvé j'ai préféré remonter les nodes et explorer l' "entité" relative au node trouvé. Et donc je suis remonté par ParentNode pour explorer l' "entité". Un peu à l'image du XPath que j'avais décrit.

Assure toi dans ton cas qu'il n'y a qu'une seule informations (MOTIF) dans la famille où se trouve l'élément (NATTRV) contenant le texte recherché (NTI3), sinon tu n'auras que la dernière. Dans l'autre cas, tu peux les avoir toutes.

Par contre, ta fonction récursive est intéressante pour parser un xml.

Assure toi dans ton cas qu'il n'y a qu'une seule informations (MOTIF) dans la famille où se trouve l'élément (NATTRV) contenant le texte recherché (NTI3), sinon tu n'auras que la dernière. Dans l'autre cas, tu peux les avoir toutes.

Pour ça il n'y a pas de soucis, Si <NATTRV> est rempli alors <MOTIF> l'est aussi, l'inverse n'étant pas forcément vrai (d'où mon problème de base).

J'ai juste une modification à faire, à savoir qu'il est possible que mon fichier ne contienne pas l'information en question (parce qu'il n'est pas concerné ou qu'il a mal été rempli), mais pour ça j'ai la solution, je vais éditer ma solution de ce pas !

je me disais aussi que si tu avais "NTI3" mais sans "MOTIF" cela pouvait poser problème, d'où là encore le fait de remonter vers les parents est une assurance (quand on en a besoin car un fichier xml est en effet structuré mais très/trop ouvert)

voici mon explorateur xml à partir de ton idée de fonction récursive

Sub parseXML()
Cells(1, 1).CurrentRegion.Offset(1, 0).ClearContents

    Dim xmlDoc As Object
    Set xmlDoc = New MSXML2.DOMDocument60
    xmlDoc.async = False
    Dim strPathToXMLFile As String
    strPathToXMLFile = Range("A1").Value
    xmlDoc.validateOnParse = True

    If Not xmlDoc.Load(strPathToXMLFile) Then
        MsgBox "Problème !"
        Exit Sub
    End If

    Dim niveau As Integer, ligne As Integer
    niveau = 0
    ligne = 2
    Call exploreXML(xmlDoc, niveau, ligne)

End Sub

Function exploreXML(noeud As Object, niveau As Integer, ligne As Integer)
    If noeud.ChildNodes.Length = 0 Then Exit Function
    Dim xNode As Object
    For Each xNode In noeud.ChildNodes
        If xNode.NodeType <> 3 Then
            'Debug.Print niveau, xNode.nodeName, xNode.Text
            Cells(ligne, niveau + 1) = xNode.nodeName
            Cells(ligne, niveau + 2) = xNode.Text
            ligne = ligne + 1
        End If
        niveau = niveau + 1
            Call exploreXML(xNode, niveau, ligne)
        niveau = niveau - 1
    Next
End Function

Si ton problème est résolu, n'oublie pas de clore ce fil de discussion, en cliquant sur

et de revenir quand tu veux, en tant que demandeur ou de contributeur car c'est rare de rencontrer des personnes de ton niveau de compétences.

Oups, désolé, j'étais pas mal occupé hier !

En tout cas merci encore et pas de soucis, si j'ai une autre demande ou bien si je vois que je peux aider, je n'hésiterai pas !

Rechercher des sujets similaires à "xml recuperation donnees noeud precedent vba"