Charger un nœud XML complet spécifique dans un arbre TreeView en VBA Excel

**paoloadv** · 25/04/2016, 19h47

Bonjour,
Je bute sur un problème depuis quelques temps, sans arriver à trouver de solution...
Je parts du chargement d'un fichier XML très lourd, dont j'affiche la liste de tous les noms de noeuds de premier niveau dans une ListBox (ListBoxCollections).
Je cherche à afficher dans une TreeView (TreeViewXML) non pas tout le XML du fichier chargé, mais uniquement la branche de nom de noeud sélectionné.
En lançant la macro, une incompatibilité de type s'affiche lors de l'ajout du noeud dans le TreeView. Dans le code ParseColPourTreeViewXML, le noeud trouvé TVCol est un MSXML2.IXMLDOMNodeList, alors que dans le code AddXMLnode, TVCol (oTreeNode) est transmis en tant que MSComctlLib.Node. Comment faire pour transmettre TVCol à TreeView ?

Voilà le code de la procédure évènementielle qui doit lancer sur le TreeView l'affichage spécifique de la branche de nom de noeud sélectionné dans la ListBox:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
 
Private Sub ListBoxCollections_Click()
    Me.TreeViewXML.Nodes.Clear
    Call FillTreeViewXMLonListBoxColSelection("monFichierXML.xml", Me.ListBoxCollections.Value)
    Me.TreeViewXML.Refresh
End Sub

Voilà le code de remplissage et d'affichage du TreeView sur la sélection transmise (Ne marche pas ):

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
 
Private Sub FillTreeViewXMLonListBoxColSelection(NomFichier As String, NomCollection As String)
' Nécessite la référence MSXML2.DOMDocument.6.0 ssi méthode par New MSXML2.DOMDocument60.
' Pas de référence à préciser ssi méthode CreateObject("MSXML2.DOMDocument.6.0") choisie !
' Affiche le noeud complet TVCol du nom de la collection NomCollection parsée dans le Dataset
 
    Dim XMLdoc As Object ' As MSXML2.DOMDocument60
    Dim strErrText As String
    Dim xPE As Object ' As MSXML2.IXMLDOMParseError
    Dim TVCol As Object '  ' As MSComctlLib.Node
    Dim i As Long
 
 
    ' Instanciation du parseur
    'Set XMLdoc = New MSXML2.DOMDocument60 ' doit être défini en référence MSXML, V6.0
    Set XMLdoc = CreateObject("MSXML2.DOMDocument.6.0") ' association de l'objet avec la dll
 
    ' La validation du document est inhibée (on suppose que c'est bon!)
    XMLdoc.validateOnParse = False
 
    ' Chargement du document XML
    If XMLdoc.Load(NomFichier) Then
        ' Le document a été chargé avec succès.
        ' L'analyse peut débuter...
        ' Récupération du noeud portant le nom de la collection transmise
        Set TVCol = XMLdoc.SelectNodes("//*[local-name(.)='" & NomCollection & "']")
        ' Remplissage de l'arbre XML dans TreeViewXML avec le noeud TVCol
        Call AddXMLnode(XMLdoc, TVCol)
    Else
        ' Impossible de charger le document
        ' Obtient l'objet ParseError
        Set xPE = XMLdoc.parseError
        With xPE
           strErrText = "Your XML Document failed to load " & "due the following error." & vbCrLf & _
            "Error #: " & .ErrorCode & ": " & xPE.reason & "Line #: " & .Line & vbCrLf & _
            "Line Position: " & .linepos & vbCrLf & _
            "Position In File: " & .filepos & vbCrLf & _
            "Source Text: " & .srcText & vbCrLf & _
            "Document URL: " & .URL
        End With
        MsgBox strErrText, vbExclamation
    End If
 
    ' Libération de la mémoire
    Set XMLdoc = Nothing
    Set xPE = Nothing
    Set TVCol = Nothing
End Sub

Le reste du code est issu d'une méthode trouvée sur le net, appartenant à SilkyRoad (http://excel.developpez.com/faq/?page=XML), que j'ai adapté (sans succès) pour ma compilation...

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
 
Public Sub AddXMLnode(ByRef oElem As Object, Optional ByRef oTreeNode As Object)
        ' oElem As MSXML2.IXMLDOMNode
        ' oTreeNode as object 'As MSComctlLib.Node
    Dim XMLdoc As Object ' As MSXML2.DOMDocument60
    Dim oNewNode As Object ' As MSComctlLib.Node
    Dim oNodeList As Object ' As MSXML2.IXMLDOMNodeList
    Dim i As Long
 
 
    If oTreeNode Is Nothing Then
            Set oNewNode = TreeViewXML.Nodes.Add  'Creation du noeud racine
            oNewNode.Expanded = True
        Else
            Set oNewNode = Me.TreeViewXML.Nodes.Add(oTreeNode, tvwChild) 'Ajout d'un noeud enfant
            oNewNode.Expanded = True
    End If
 
    Select Case oElem.NodeType
        Case 1 ' MSXML2.NODE_ELEMENT 'type Element
            oNewNode.Text = oElem.nodeName & " (" & GetXMLattributes(oElem) & ")"
            Set oNewNode.Tag = oElem
 
        Case 3 ' MSXML2.NODE_TEXT 'type texte
            oNewNode.Text = "Text: " & oElem.NodeValue
            Set oNewNode.Tag = oElem
 
        Case 4 ' MSXML2.NODE_CDATA_SECTION 'type Cdata
            oNewNode.Text = "CDATA: " & oElem.NodeValue
            Set oNewNode.Tag = oElem
 
        Case Else
            oNewNode.Text = oElem.NodeType & ": " & oElem.nodeName
            Set oNewNode.Tag = oElem
    End Select
 
    Set oNodeList = oElem.ChildNodes 'boucle récursive pour ajouter tous les noeuds enfants
 
    For i = 0 To oNodeList.Length - 1
        Call AddXMLnode(oNodeList.Item(i), oNewNode)
    Next i
End Sub
 
 
Private Function GetXMLattributes(ByRef oElm As Object) As String
    ' oElm As MSXML2.IXMLDOMNode
    Dim sAttr As String
    Dim i As Long
 
    sAttr = ""
 
    For i = 0 To oElm.Attributes.Length - 1 'boucle sur tous les attributs
        sAttr = sAttr & oElm.Attributes.Item(i).nodeName & "='" & _
            oElm.Attributes.Item(i).NodeValue & "' "
    Next i
 
    GetXMLattributes = sAttr
End Function

**paoloadv** · 08/06/2016, 14h35

Bonjour (à moi même !

, vu que personne ne m'a aidé ici !)

J'ai trouvé la solution depuis un moment, mais j'attendais de voir si certains allez me donner leur avis. Pas foule au portillon ici... Une petite erreur dans le code... Si cela intéresse un jour quelqu'un j'y répondrai volontiers ! Pas comme d'autres...

Tchao !