0

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
Tim Williams
  • 154,628
  • 8
  • 97
  • 125
Rob
  • 1,235
  • 2
  • 19
  • 44

1 Answers1

1

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:

How can I pretty-print XML source using VB6 and MSXML?

Community
  • 1
  • 1
Tim Williams
  • 154,628
  • 8
  • 97
  • 125
  • Very Smart and nice elegant solution - I knew there was a simple approach I just wasn't seeing it! – Rob Oct 08 '15 at 21:33
  • Dont suppose you know how to add a DTD declaration with MSXML ? – Rob Oct 09 '15 at 11:14
  • No I've never done that but maybe look at: http://microsoft.public.xml.narkive.com/d2jgB7dN/adding-doctype-with-domdocument – Tim Williams Oct 09 '15 at 16:32