Using MSXML and VBA I want to create a hiarachy of the same XML nodes.
My input data looks like this in two columns from Excel
The first column looks like this
Lvl 1
Lvl 2
Lvl 2
Lvl 1
Lvl 2
Lvl 3
The previous lower level is always regarded as the parent of the next higher level
So the above actually translates to
Lvl 1
Lvl2
Lvl2
Lvl1
Lvl2
Lvl3
The second column contains the ident of the xml element and this is unique.
So the resulting xml looks like
<section ident="item1">
<section ident="item2"></section>
<section ident="item3"></section>
</section>
<section ident="item4">
<section ident="item5">
<section ident="item6"></section>
</section>
</section>
I have it working where I loop over each line with an if of a certain level I append to the previous. But for each level I have to repeat my if to check the level, creating an object for each level. Lots of objects lots of pain.
I have appendChild and insertBefore available to me as methods in msxml.
How can I have minimal code to create this structure? And ensure it works for more than 3 levels?
Existing code (stripped all the other setting of attributes for the section for readability:
As you can see its not very scalable, Id love to be able to maintain one common section but setting properties once.
For i = LBound(varLvlSections) To UBound(varLvlSections)
If varLvlSections(i, 1) = "Lvl 1" Then
'add level section element
Set sectionLvl1 = dom.createElement("section")
mainSection.appendChild sectionLvl1
sectionLvl1.setAttribute "ident", varLvlSections(i, 2)
End If
If varLvlSections(i, 1) = "Lvl 2" Then
'add level section element
Set sectionLvl2 = dom.createElement("section")
sectionLvl1.appendChild sectionLvl2
sectionLvl2.setAttribute "ident", varLvlSections(i, 2)
End If
If varLvlSections(i, 1) = "Lvl 3" Then
'add level section element
Set sectionLvl3 = dom.createElement("section")
sectionLvl2.appendChild sectionLvl3
sectionLvl3.setAttribute "ident", varLvlSections(i, 2)
End If
next i
Something like this might work for you. Has no error checking on the levels (will break if there's a "level 4" with no previous "level 3").
Sub Tester()
Dim d, doc, root, lvl As Long, r, el, id
Dim parents(0 To 20) 'handle up to 20 levels...
Set doc = New MSXML2.DOMDocument
Set root = doc.createElement("root")
doc.appendChild root
Set parents(0) = root 'Parent node for all "Level 1" nodes...
d = Range("a1").CurrentRegion.Value
For r = LBound(d, 1) To UBound(d, 1)
lvl = CLng(Split(d(r, 1), " ")(1)) 'get level
Set el = doc.createElement("section")
el.setAttribute "ident", d(r, 2)
parents(lvl - 1).appendChild el
Set parents(lvl) = el ' Make this the current Parent node for
' any nodes directly below
Next r
Debug.Print PrettyPrintXML(doc.XML)
End Sub
PrettyPrintXML
from Daniel's answer here: