VBA - lecture d'un fichier XML à géométrie variable

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é :

Code:

---

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

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 ?

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

Bonjour Faenor86 et bonjour aux forum,

Pourquoi ne pas faire une fonction récursive ?
1 - Tu boucle sur ton élément racine
2 - Si la variable est de type String (Node.text) alors tu renvoi la valeur
3 - Si la variable est de type Object (Node.ChildNodes) alors tu renvoi la fonction
4 - la fonction s'arrête quand elle trouve un critère (text)

Voici un code bricolé à la va vite et non testé. A adapter à ta demande exacte.

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23

public function GetNode(Element as object, sCriteria as string) as variant   Dim Node as object   for each Node in Element   select case vartype(node)   case vbobject   Set Node = Getnode(Node, sCriteria)   case vbstring   if Node.text = sCriteria then Getnode = Node.text end if   end select   next node   end function

---

A+
John

Bonjour John,

Merci d'avoir pris le temps d'apporter un élément de réponse à ma demande.

J'ai fait un test de récursivité à l'instant, histoire d'appréhender ce concept que je ne maîtrisais pas. Cela à l'air d'être tout à fait à propos :D
On m'a également conseiller d'éviter tant que possible les variables de types OBJECT et d'activer la référence Microsoft XML v3 ou v6.0.
Je vais faire plusieurs test ce Weekend et je te tiens informé

crd

Rebonjour !

Avec un peu d'aide, j'ai finalement réussi à atteindre mon objectif. En effet sans récursivité c'était quasiment mission impossible. ci-dessous ma fonction :

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20

Function ExploreNode(NumNiveau, oNode)   If oNode.NodeType = 3 Then Debug.Print oNode.text Debug.Print vbCrLf Else   Debug.Print NumNiveau & " : " & oNode.BaseName   If oNode.HasChildNodes Then   For Each oElement In oNode.ChildNodes ExploreNode = ExploreNode(NumNiveau + 1, oElement) Next End If End If   End Function

---