XL 2016 VBA - lecture fichier xml à géométrie variable

[faenor86]

Bonjour à tous,

Je commence à comprendre le fonctionnement du DOM et j'ai pu produire ou reproduire certains scripts permettant la lecture et l'extraction de données présentes dans un fichier XML.

Cependant la plus part de mes lecture présentent du code appliqué à un fichier présentant une profondeur de "NOEUDS" définie. ci-dessous un exemple de code qui marche très bien pour 3 niveaux à partir d'un noeud selectionné :

Sub W3C1()
 
Dim xmlDoc As Object
Dim RacineElement, BookElement As Object
 
Set xmlDoc = CreateObject("Microsoft.XMLDOM")
 
xmlDoc.Async = "false"
xmlDoc.Load (ThisWorkbook.Path & "\BOOKSHOP.xml")
 
Set RacineElement = xmlDoc.SelectNodes("//bookstore")
 
Dim Nv1, Nv2, Nv3 As Object
 
For Each Nv1 In RacineElement
    Debug.Print Nv1.BaseName & vbCrLf
    For Each Nv2 In Nv1.ChildNodes
        Debug.Print Nv2.BaseName
        For Each Nv3 In Nv2.ChildNodes
            Debug.Print Nv3.BaseName & " : " & Nv3.text
        Next
        Debug.Print vbCrLf
    Next
Next
 
 
Set xmlDoc = Nothing
 
End Sub

Au cas présent, le fichier xml utilisé est tiré d'un exemple tiré de ce site : https://www.w3schools.com/xml/dom_intro.asp

Ma question : Est-il possible techniquement d'adapter ce code à N noeuds enfants ? (sans connaitre en avance la profondeur du graphe)

En idée serait de variabiliser le chemin du noeud auquel on s'intéresse avec une boucle WHILE "NoeudAnalysé" "a des noeuds enfants et de récupérer le nom des balises + les valeurs mais il faudrait que cette fonction sous récursive et ça je ne sais pas faire.....

Merci d'avance pour vos retours !
Très cordialement

 

[patricktoulon]

bonsoir
si tu veux faire abstraction de l'arborexcence c'est une boucle for each element qu'il te faut

 

[Dranreb]

Bonsoir.
Ce que je peux vous dire c'est que je serais plus tranquille pour étudier cette possibilité si le type Object était complètement banni de cette programmation, et si la référence "Microsoft XML, v6.0" était cochée. Parce que moi je ne connais pas les membres de ces objets.
Une information quand même de l'explorateur d'objets: La classe IXMLDOMNode, détentrice de la propriété childNodes possède aussi une propriété hasChildNodes As Boolean. De quoi déterminer peut être s'il y a lieu ou non d'engager un appel récusif d'une procédure …

 

[Dranreb]

Bonjour.
Il y a de la programmation qui fait un peu ce que vous dites dans ce classeur.

 

[faenor86]

Bonjour !
merci pour vos retours.

@patricktoulon : aurais-tu possibilité de me faire un exemple de boucle FOR EACH ELEMENT ?

@Dranreb : je vais regarder ton fichier et je prends note de la coche pour la référence la librairie "Microsoft XML, v6.0". J'ai déjà testé hasChildNodes, par contre c'est l'appel à des fonctions récursives que je ne maitrise pas...

Bien cordialement

 

[Dranreb]

Pourquoi ne les maitrisez vous pas ? (C'est juste une question: une fois les tenants et aboutissants nécessaires bien cernés, c'est normal que ça aboutisse à un processus global parfois difficile à suivre …)
Ma fonction DicoJs est récursive par exemple.
Ma fonction SousDicoJs ne l'est pas.
Il y a longtemps que je n'avais plus examiné ce code, à priori je me serais plus attendu à l'inverse …

 

[faenor86]

Bonsoir Dranreb, Bonsoir le Forum,

J'ai réussi à atteindre mon objectif. En effet, j'ai trouvé la solution à mon problème à travers la récursivité. Notion que programmation que je ne connaissais que de nom mais qui s'avère très utile dans certains cas... Je saurais m'en souvenir !

ci-dessous le code de ma fonction de parcours pour ceux que cela intéresse :

Function ExploreNode(NumNiveau, oNode)

'cas 1 : le noeud est de type text (Element = 1 // Text = 3)
If oNode.NodeType = 3 Then
    Debug.Print oNode.text
    Debug.Print vbCrLf
Else
'cas 2 : le noeud est de type Element
    Debug.Print NumNiveau & " : " & oNode.BaseName

    If oNode.HasChildNodes Then
        For Each oElement In oNode.ChildNodes
            'ma fonction d'exploration s'appelle elle-même
            ExploreNode = ExploreNode(NumNiveau + 1, oElement)
        Next
    End If
End If

End Function

Ainsi que le code du sous-programme qui appelle la fonction

Sub RecursiviteXML()

Dim xmlDoc As New DOMDocument
Dim RNode As IXMLDOMElement
Dim oNode As IXMLDOMElement
Dim oElement As IXMLDOMElement

Dim NumNiveau As Long

'Chargement du fichier xml
xmlDoc.Async = "false"
xmlDoc.Load (ThisWorkbook.Path & "\MON_FICHIER_TEST.xml")
 
'On initialise les paramètres de la fonction
NumNiveau = 0
Set oNode = xmlDoc.DocumentElement
Debug.Print ExploreNode(NumNiveau, oNode)

Debug.Print vbCrLf

Set xmlDoc = Nothing

End Sub

Merci
Bien cordialement

 

[patricktoulon]

re
bonsoir la dans ce model de structure bien que ça peut paraître séduisant la récursivité est inutile

la même chose dans un do loop fait exactement la même chose
d'ailleurs en cas de listage (memoire) c'est plus difficile de faire des apels récursifs que de memoriser dans un do loop car dans l'apel récursif il faut renvoyer tout ce qui a été lu pour le garder en stock mémoire et oui en effet tout les variable sont réinitialisées forcement a chaque apel
dans le cas que tu présente tu fait un debug.print mais essaie de mémoriser la collection des object trouvés tu va voir comme c'est beaucoup plus compliqué que cela

 

[Dranreb]

Moi je ne vois pas ce que renvoie votre fonction si Not oNode.HasChildNodes, de sorte que je ne vois ce qu'elle renvoie dans aucun cas …
Mais évidemment, le End Function n'est pas montré, alors vous avez peut être encore des instruction qui lui font renvoyer quelque chose ?

 

[patricktoulon]

Bonsoir
tu a compris comment on faisait un apel récursif voyons maintenant si tu va savoir ramener les éléments a la sub appelant ta fonction

BIEN QUE!! dans un esprit de simplicité un do loop changeant le parent aurait très bien fait l'affaire et plus simple pour stocker éventuellement dans une variable les éléments ce qui va être plus compliqué avec la récursivité qui a chaque relance ment de la fonction réinitialise les variables
obligé de doter la fonction de variables static ou ballotter la variable a chaque relance ment en optional

c'est pas si simple surtout avec le html XML

 

[faenor86]

Bonjour,

@Dranreb : oui pas de Else à If oNode.HasChildNodes. Est-ce obligatoire ?

@patricktoulon : il semblerait que tu ais anticipé mon prochain pb.... Par contre j'avoue ne pas bien comprendre ton autre méthode car tu sembles dire qu'il faudrait partir des éléments enfants et de revenir au parent ? Par défaut je suis censé ne pas connaitre à l'avance la structure du fichier xml donc comment faire ?

J'ai juste voulu ajouter une petite modification à mon code afin de me permettre de stocker dans un tableau "les feuilles de mon arbre XML" à savoir les valeurs text des éléments sans enfants). Et là j'ai une erreur d’incompatibilité de type qui survient... à mon For Each oElement in oNode.ChildNodes....

Je me permets de vous déposer le code complet modifié. NB : j'ai du déplacer la déclaration de variable de oElement dans la fonction car sinon ça bug directement à l'appel de la fonction.

Sub RecursiviteXML2()

Dim xmlDoc As New DOMDocument
Dim RNode As IXMLDOMElement
Dim oNode As IXMLDOMElement


Dim NumNiveau As Long

'Chargement du fichier xml
xmlDoc.Async = "false"
xmlDoc.Load (ThisWorkbook.Path & "\RCS-A_BXA20200001.xml")
 
'On initialise les paramètres de la fonction
NumNiveau = 0

Set oNode = xmlDoc.DocumentElement
Debug.Print ExploreNode2(NumNiveau, oNode)

Debug.Print vbCrLf

Set xmlDoc = Nothing

End Sub

Function ExploreNode2(NumNiveau, oNode)

Dim oElement As IXMLDOMElement
Dim TabNoeudText() As Variant
Dim i As Long

'cas 1 : le noeud est de type text (Element = 1 // Text = 3)
If oNode.NodeType = 3 Then
    Debug.Print oNode.text
    Debug.Print vbCrLf
    ReDim Preserve TabNoeudText(i)
    TabNoeudText(i) = oNode.text
    i = i + 1
Else
'cas 2 : le noeud est de type Element
    Debug.Print NumNiveau & " : " & oNode.BaseName

    If oNode.HasChildNodes Then
        For Each oElement In oNode.ChildNodes
            'ma fonction d'exploration s'appelle elle-même
            ExploreNode2 = ExploreNode2(NumNiveau + 1, oElement)
        Next
    End If
End If

End Function

Avez-vous une idée de ce qui ne va pas ?

Merci d'avance pour votre aide

 

[Dranreb]

Il est en tout cas fondamental qu'une Function renvoie quelque chose.
Et si elle est récursive, mais qu'elle ne renvoie rien lorsque la condition d'appel récursif n'est pas remplie, elle ne renverra rien non plus dans aucun cas.

 

[patricktoulon]

bonjour

et ou est la static ou globale module pour les conserver ??????