Build treeview from xml

[speakers_86]

Anyone know how to do it?

I found this reference, and tried the following code:

The reference I have is Microsoft XML, v3.0.

From the link above, I had to get rid of all of the "MSXML." from the variables, because it would not compile. So MSXML.DOMDocument became DOMDocument.

The blank messagebox does not fire.

Private Function CreateXML as string

Dim strXML as string
strXML="some xml markup"

Dim xDoc As DOMDocument
Set xDoc = New DOMDocument
xDoc.validateOnParse = False
If xDoc.Load(strXML) Then
   ' The document loaded successfully.
   ' Now do something intersting.
   MsgBox ""
   DisplayNode xDoc.ChildNodes, 0
Else
   ' The document failed to load.
   ' See the previous listing for error information.
End If
End Function

Public Sub DisplayNode(ByRef Nodes As IXMLDOMNodeList, _
   ByVal Indent As Integer)

   Dim xNode As IXMLDOMNode
   Indent = Indent + 2

   For Each xNode In Nodes
      If xNode.NodeType = NODE_TEXT Then
         Debug.Print Space$(Indent) & xNode.ParentNode.nodeName & _
            ":" & xNode.NodeValue
      End If

      If xNode.HasChildNodes Then
         DisplayNode xNode.ChildNodes, Indent
      End If
   Next xNode
End Sub

 

[spikepl]

try to feed the .Load from a file - that works fine for me. I never tried to plug a string in directly, and don't think you can. Look up the documentation for .Load

 

[speakers_86]

So you think if I save the string to an xml document first and load that it will work? That would make sense as to why the message box does not fire.

 

[spikepl]

Are you asking whether I mean what I write in #2 ? Noooooooooooo, it was just to pass the time

 

[speakers_86]

Sorry. A bit too much to drink I guess. I am having more success now, you were right. Also, .loadXML() can load a string.

 

[gemma-the-husky]

see if this tree-walker I uploaded a couple of years ago helps

http://www.access-programmers.co.uk/forums/showthread.php?t=166861&highlight=gemma-the-husky

it should help with the syntax, anyway.

 

[speakers_86]

Thank you gemma. That did help, and I found a few good links too. This is hard because I have to teach myself two different things at the same time. But I've made some progress. I can sort of navigate the nodes of the xml, and I can add nodes to the treeview. Here is what I am up to so far. By no means am I done. This is all just part of the learning process.

Public Sub a()
    'On Error GoTo err_a
    Debug.Print
    Dim xml    As MSXML2.DOMDocument
    Set xml = New DOMDocument

    Dim FirstLevel As IXMLDOMNode
    Dim SecondLevel As IXMLDOMNode
    Dim ThirdLevel As IXMLDOMNode
    Dim FourthLevel As IXMLDOMNode
    Dim FifthLevel As IXMLDOMNode
    Dim Element As IXMLDOMElement
    
    Dim objTree As TreeView
    Set objTree = Me.TreeView0.Object

    xml.async = False
    xml.LoadXML (CreateXML)
    'Debug.Print xml.DocumentElement.NamespaceURI   'http
    'Debug.Print xml.FirstChild.nodename            'customui
    For Each FirstLevel In xml.ChildNodes
        Debug.Print FirstLevel.nodename
        For Each SecondLevel In FirstLevel.ChildNodes
            Debug.Print SecondLevel.nodename
            For Each ThirdLevel In SecondLevel.ChildNodes
                Debug.Print ThirdLevel.nodename
                For Each FourthLevel In ThirdLevel.ChildNodes
                    Debug.Print FourthLevel.nodename
                    For Each FifthLevel In FourthLevel.ChildNodes
                        Debug.Print FifthLevel.nodename
                        For Each Element In FifthLevel.ChildNodes
                            Debug.Print Element.getAttribute("id")
                        Next
                    Next
                Next
            Next
        Next
    Next
        objTree.Nodes.Clear
        objTree.Nodes.Add , , "root", "test"
        objTree.Nodes.Add "root", tvwChild, "unique", "blah"
        objTree.Nodes.Add "unique", tvwChild, "thisshouldbeunique", "works"
    Set xml = Nothing
    Set objTree = Nothing
    Exit Sub

err_a:
    Debug.Print Err.Description
    Err.Clear
    Set xml = Nothing
    Set node = Nothing
end sub

edit- I thought you might like to see what I am working towards. The idea is to make something like a wizard for building ribbons. Even though it is no where near complete, it is actually already very useful if you want to build a ribbon from scratch. I'm thinking that the controls will stay unbound, but the form's record source will be the ribbons table. Some control that lets you choose which ribbon to view would fill the unbound controls. This way ribbons can be stored as one memo field for experienced users, but the unbound controls filled for an easy gui interface for the less experienced (or the lazy, like me!).

edit-The unlabeled check boxes you'll find dictate whether it is a callback or not. Check for callback (getVisible) or unchecked for not a callback (visible).

 

[speakers_86]

Here's another update. I can get all the nodes, and post them to the tree, but I can't get all the attributes of each node, at least not without using the getAttribute method, which requires me hardcoding attribute names. Any help would be great.

Public Sub a()
    On Error GoTo err_a
    Debug.Print
    Dim xml    As MSXML2.DOMDocument
    Set xml = New DOMDocument

    Dim objTree As TreeView
    Set objTree = Me.TreeView0.Object
    objTree.Nodes.Clear
    
    xml.async = False
    xml.LoadXML (CreateXML)
        
    DisplayNode xml.ChildNodes
    
    Set xml = Nothing
    Set objTree = Nothing
    
    Exit Sub

err_a:
    Debug.Print Err.Description
    Err.Clear
    Set xml = Nothing
    Set objTree = Nothing
End Sub

Public Sub FillTree(Parent As String, Key As String, Text As String)
    Dim objTree As TreeView
    Set objTree = Me.TreeView0.Object
    
    objTree.Nodes.Add Parent, tvwChild, Key, Text
    
    Set objTree = Nothing
End Sub

Public Sub DisplayNode(ByRef Nodes As IXMLDOMNodeList)

   Dim xNode As IXMLDOMNode

   For Each xNode In Nodes
         Debug.Print xNode.nodename
        DisplayAttribute (xNode)
      If xNode.HasChildNodes Then
         DisplayNode xNode.ChildNodes
      End If
   Next xNode
End Sub

'this one doesn't work
Public Sub DisplayAttribute(ByRef node As IXMLDOMNode)
    Dim att As IXMLDOMAttribute
    Dim i As Integer
    
    On Error GoTo exitsub
    For i = 0 To 10
        Debug.Print node.Attributes(i).Text
    Next
exitsub:
End Sub

edit-I got it!
yet another edit- The key values are being duplicated in the treeview, so the treeview is showing all tabs under one node. I'm struggling to fix this issue, but I'll post back when I figure it out. If anyone has a keen insight, feel free to clue me in.

Public Sub DisplayNode(ByRef Nodes As IXMLDOMNodeList)
    On Error Resume Next
    Dim xNode  As IXMLDOMNode
    Dim i      As Integer
    Dim strValue As String

    Dim objTree As TreeView
    Set objTree = Me.TreeView0.Object

    For Each xNode In Nodes
        objTree.Nodes.Add xNode.ParentNode.nodename, tvwChild, xNode.nodename, xNode.nodename
        For i = 0 To 10
            strValue = xNode.Attributes.Item(i).BaseName & " = " & xNode.Attributes.Item(i).nodeTypedValue
            If IsNull(xNode.Attributes.Item(i).BaseName) Then
                i = 10
            Else
                FillTree xNode.nodename, strValue, strValue
            End If
        Next
        If xNode.HasChildNodes Then
            DisplayNode xNode.ChildNodes
        End If
    Next xNode

    Set objTree = Nothing

End Sub

 

[speakers_86]

Yeeeeah! Amazing success. From what I can see, no one has done this in access yet, so I didn't have much to work on. Here is the code, followed by some xml I have successfully added to the tree.

Public Sub a()

'created by speakers_86
'feel free to use this as you like
'but i appreciate some credit

    On Error GoTo err_a
    Dim xml    As MSXML2.DOMDocument
    Set xml = New DOMDocument

    Dim objTree As TreeView
    Set objTree = Me.TreeView0.Object
    objTree.Nodes.Clear
    
    'hardcode the root
    objTree.Nodes.Add , , "#document", "#document"
    
    'wait for file to finish loading
    xml.async = False
    
    'load the string
    xml.LoadXML (CreateXML)
        
    DisplayNode xml.ChildNodes
    
    Set xml = Nothing
    Set objTree = Nothing
    
    Exit Sub

err_a:
    MsgBox Err.Number & ": " & Err.Description
    Err.Clear
    Set xml = Nothing
    Set objTree = Nothing
End Sub

Code below modified on 3 March 2012

Public Sub DisplayNode(ByRef Nodes As IXMLDOMNodeList)

'created by speakers_86
'feel free to use this as you like
'but i appreciate some credit

    On Error Resume Next
    Dim xNode  As IXMLDOMNode
    Dim i As Integer
    Dim strValue As String
    Dim strParent As String
    Dim strNodeKey As String
    
    Dim objTree As TreeView
    Set objTree = Me.TreeView0.Object
    
    
    For Each xNode In Nodes
        
        'strParent contains the unique id for the node's parent node in the tree
        'this select case ensures uniqueness with the parent's id
        Select Case xNode.ParentNode.nodeName
            Case "#document"
                strParent = "#document"
            Case "customUI"
                strParent = "customUI"
            Case "ribbon"
                strParent = "ribbon"
            Case "tabs"
                strParent = "tabs"
            Case "commands"
                strParent = "commands"
            Case "officeMenu"
                strParent = "officeMenu"
            Case Else
                strParent = xNode.ParentNode.Attributes.getNamedItem("id").nodeTypedValue
        End Select
        
        
        'strNodeKey contains the unique key for the selected node.
        'we have to make sure this value is unique
        Select Case xNode.nodeName
            Case "customUI"
                strNodeKey = "customUI"
            Case "ribbon"
                strNodeKey = "ribbon"
            Case "tabs"
                strNodeKey = "tabs"
            Case "commands"
                strNodeKey = "commands"
            Case "officeMenu"
                strNodeKey = "officeMenu"
            Case "button"
                If strParent = "officeMenu" Then
                    strNodeKey = xNode.Attributes.getNamedItem("idMso").nodeTypedValue
                End If
                strNodeKey = xNode.Attributes.getNamedItem("id").nodeTypedValue
            Case "splitButton"
                If strParent = "officeMenu" Then
                    strNodeKey = xNode.Attributes.getNamedItem("idMso").nodeTypedValue
                End If
            Case "command"
                strNodeKey = xNode.Attributes.getNamedItem("idMso").nodeTypedValue
            Case Else
                strNodeKey = xNode.Attributes.getNamedItem("id").nodeTypedValue
                If Len(Nz(strNodeKey)) = 0 Then strNodeKey = xNode.Attributes.getNamedItem("idMso").nodeTypedValue
                If Len(Nz(strNodeKey)) = 0 Then strNodeKey = xNode.nodeName
        End Select

        'these values are used when adding the node to the tree
        'if you only want to see ids, you can change this section
        strValue = xNode.Attributes.getNamedItem("label").nodeTypedValue
        If Len(Nz(strValue)) = 0 Then strValue = xNode.Attributes.getNamedItem("idmso").nodeTypedValue
        If Len(Nz(strValue)) = 0 Then strValue = xNode.Attributes.getNamedItem("id").nodeTypedValue
        If Len(Nz(strValue)) = 0 Then strValue = xNode.nodeName
        
        'add the node to the tree
        Select Case xNode.nodeName
            Case "tab"
                objTree.Nodes.Add strParent, tvwChild, strNodeKey, strValue
            Case "group"
                objTree.Nodes.Add strParent, tvwChild, strNodeKey, strValue
            Case Else
                objTree.Nodes.Add strParent, tvwChild, strNodeKey, strNodeKey
        End Select
        
        'search the node for attributes, add them to the tree
        For i = 0 To 10
            If IsNull(xNode.Attributes.Item(i).BaseName) Then
                Exit For
            Else
            strValue = xNode.Attributes.Item(i).BaseName & " = " & xNode.Attributes.Item(i).nodeTypedValue
                'I don't know why, but the dtd schema does not show up as a basename.  You can
                'comment this if you want, but then strValue will by " = http://..." with no
                'base name.
                If Left(xNode.Attributes.Item(i).nodeTypedValue, 4) = "http" Then strValue = "xmlns" & strValue
                objTree.Nodes.Add strNodeKey, tvwChild, strParent & strNodeKey & strValue, strValue
            End If
        Next
        
        'loop through all subnodes
        If xNode.HasChildNodes Then
            DisplayNode xNode.ChildNodes
        End If
        
    Next xNode

    Set objTree = Nothing
    Set xNode = Nothing
End Sub

Of course this xml is not practical, but it illustrates what can be done with only two subs.

<customUI xmlns="http://schemas.microsoft.com/office/2006/01/customui"> 
   <commands> 
   </commands>
   <ribbon > 
      <officeMenu> 
      </officeMenu> 
  <tabs> 
        <tab id="tet" label="tete"> 
<group id="InsertGroupID"
       label="InsertLabel"
       visible="true"> 
<group id="a"
       label="InsertLabel"
       visible="true"> 
<group id="b"
       label="InsertLabel"
       visible="true"> 

</group>

</group>

</group>
       </tab> 
        <tab id="tab2" label="tab2"> 
<group id="test"
       label="InsertLabel"
       visible="true"> 

</group>
       </tab> 
   </tabs> 
 </ribbon> 
</customUI>