Indent XML (without recursion)

[eyeRmonkey]

This module allows you to indent XML before saving it to a file without using VB string functions. It does the work with an extremely small amount of code and does it properly using an XSL transformation instead of a recursive function.

This module is the result of this thread. I want to extend a huge "thank you" to MartinLiss for reasearching XSL transformations and solving this issue.

It will transform your XML from this:

<Values><FirstName>Rod</FirstName><LastName>Stephenshgsgfs</LastName><Street>1234 Programmer Place</Street><City>Bugsville</City><State>CO</State><Zip>80276</Zip></Values>

to this:

<Values>
	<FirstName>Rod</FirstName>
	<LastName>Stephenshgsgfs</LastName>
	<Street>1234 Programmer Place</Street>
	<City>Bugsville</City>
	<State>CO</State>
	<Zip>80276</Zip>
</Values>

Attached is the module and a small sample project.

To use it in any project all you have to do is add a reference to any version of MSXML.dll to your poject then call IndentXML() and pass a DOMDocument (or DOMDocument26, DOMDocument30 or DOMDocument40) object to the sub. After that the .xml property of that DOMDocument will be tabbed properly.

UPDATES:
11/16/2005 - Added 2 optional arguments to the IndentXML subroutine:

1) bUnindent - Boolean value telling wether or to unindent the XMLDOM object passed into oXMLDoc.
2) bLeaveHeader - Removes a problems from the last version where a tag was automatically added to the top of the document. If you want this tag back, set this parameter to true.

[eyeRmonkey]

Updates made to remove the major problem (the XML tag that was forced onto the first line) and added the ability to unindent the XML.

[takedownca]

Your XSL based code works great, but there is one change I'm having some trouble implementing. What needs to change in the XSL file in order to not add an end tag? For example,

I don't want this:
<element attribute="value"/>

to be changed to this:
<element attribute="value">
</element>

I know it's just a matter of figuring out the XSL syntax, but I don't have time to learn XSL just to make this one change. Thanks for the help.

[eyeRmonkey]

I really can't answer your question for sure, but all I know is that <element attribute="value"/> isn't proper syntax in some XHTML browsers. I know this is XML and not broswer specific, but it might work is you do this instead:

<element attribute="value" />

Just a though. Maybe Marty could give his input on th XLS side of things.

[adamm83]

I'm just curious. Your code reads the XML and formats it properly then prints it into a textbox, but how can i get it to write back to the XML file properly formatted?
Would I have to add code like the following after it runs the IndentXML function:

Open App.Path & "\my.xml" For Output As #1
                Print #1, oXMLDoc.xml
            Close #1

Or is there another way to do it?

!!! EDIT !!!:
Nevermind, I figured it out. Just do this after the IndentXML function is called, or whenever you want to save the xml to a file:

oXMLDoc.save App.Path & "\my.xml"

!!! EDIT !!! :
I also want to make a suggestion to add to the code (or rather to change something in the code). In the IndentXML function, where it removes the header, it did not work properly for me. I am using MSXML 6.0 and the header that gets printed is only <?xml version="1.0"?>, so what I did is this:

original code:

' Get rid of the added header line
            If Not bLeaveHeader Then
                sResult = Replace$(sResult, "<?xml version=" & QT & "1.0" & QT & " encoding=" & QT & "UTF-16" & QT & "?>", vbNullString, , , vbTextCompare)
            End If

new code:
Note: you will have to declare the following at the beginning of the function

Dim iStartHeader    As Integer
    Dim iEndHeader      As Integer

Replace the original code with the following:

' Get rid of the added header line
            iStartHeader = InStr(1, sResult, "<?xml")
            If Not bLeaveHeader And iStartHeader > 0 Then
                iEndHeader = InStr(iStartHeader, sResult, "?>") + 2
                sResult = Replace$(sResult, Mid(sResult, iStartHeader, iEndHeader - iStartHeader), vbNullString, , , vbTextCompare)
            End If

This way, it searches for the beginning of the header and if that exists, it searches for the rest of the line and removes it.

[eyeRmonkey]

Good stuff, Adamm. I probably won't be modifying this code considering I am busy with many projects and college right now, but feel free to modify it as you see fit and upload a new zip and add your name to the credits. Just make sure you specify all the things that are different between the two versions.

[Jade Fox]

Your XSL based code works great, but there is one change I'm having some trouble implementing. What needs to change in the XSL file in order to not add an end tag? For example,

I don't want this:
<element attribute="value"/>

to be changed to this:
<element attribute="value">
</element>

I know it's just a matter of figuring out the XSL syntax, but I don't have time to learn XSL just to make this one change. Thanks for the help.

I changed the XSL_FILE to the following, and it appears to have solved the problem. I haven't debugged it, but it works for me. Not exactly sure why it works, though. My XPath and XSL is pretty rusty.

XSL_FILE = _
            "<?xml version=" & QT & "1.0" & QT & " encoding=" & QT & "UTF-8" & QT & "?>" & vbCrLf & _
            "<xsl:stylesheet version=" & QT & "1.0" & QT & " xmlns:xsl=" & QT & "http://www.w3.org/1999/XSL/Transform" & QT & ">" & vbCrLf & _
            "     <xsl:output method=" & QT & "xml" & QT & " version=" & QT & "1.0" & QT & " encoding=" & QT & "UTF-8" & QT & " indent=" & QT & sIndent & QT & "/>" & vbCrLf & _
            "     <xsl:template match=" & QT & "@* | node()[count(*)>0]" & QT & ">" & vbCrLf & _
            "          <xsl:copy>" & vbCrLf & _
            "               <xsl:apply-templates select=" & QT & "@* | node()" & QT & " />" & vbCrLf & _
            "          </xsl:copy>" & vbCrLf & _
            "     </xsl:template>" & vbCrLf & _
            "     <xsl:template match=" & QT & "node()[count(*)=0]" & QT & ">" & vbCrLf & _
            "          <xsl:copy>" & vbCrLf & _
            "               <xsl:apply-templates select=" & QT & "@*" & QT & " />" & vbCrLf & _
            "          </xsl:copy>" & vbCrLf & _
            "     </xsl:template>" & vbCrLf & _
            "</xsl:stylesheet>"

[sebgur]

Great, very useful, many thanks.

Simply changed DOMDocument to DOMDocument60 and it works with Microsoft XML v6.0.

[dilettante]

While I can understand not wanting to roll your own code to accomplish this from dirt (i.e. String operations in VB code), this approach is probably worse than you could do in pure VB6. XSL is notoriously slow and the XSLT engine itself is tremendously bulky. Try testing with a 750KB XML document!


An obvious alternative if you are already loading an MSXML library is to use the SAX2 objects. They can make this is trivial matter, and do the entire thing far faster using far less memory.

Here is 100% of the code in this demo, and you can basically ignore everything outside of cmdReformat_Click:

Option Explicit

Private Sub ManageUI()
    'Make UI changes based on the relationships of controls and their
    'curent values.
    chkStandalone.Enabled = chkOmitXMLDeclaration.Value <> vbChecked
End Sub

Private Sub chkOmitXMLDeclaration_Click()
    ManageUI
End Sub

Private Sub cmdReformat_Click()
    Dim rdrCompact As MSXML2.SAXXMLReader
    Dim wrtFormatted As MSXML2.MXXMLWriter

    Set wrtFormatted = New MSXML2.MXXMLWriter
    With wrtFormatted
        .omitXMLDeclaration = chkOmitXMLDeclaration.Value = vbChecked
        .standalone = chkStandalone.Value = vbChecked
        .indent = chkIndent.Value = vbChecked
        .output = "" 'Tells MXXMLWriter we want Unicode String output.
        Set rdrCompact = New MSXML2.SAXXMLReader
        With rdrCompact
            Set .contentHandler = wrtFormatted
            Set .dtdHandler = wrtFormatted
            Set .errorHandler = wrtFormatted
            .putProperty "http://xml.org/sax/properties/lexical-handler", _
                         wrtFormatted
            .putProperty "http://xml.org/sax/properties/declaration-handler", _
                         wrtFormatted
            .parse txtOriginal.Text
        End With
        txtPrettied.Text = .output
    End With
End Sub

Private Sub Form_Load()
    ManageUI
End Sub

[sebgur]

Good to know, thanks. I'll try to use your code instead. But in my applications the files are rarely larger than 10KB. And it's only temporary as I'm planning to start working in VSTO/C# soon.
But anyway, always good to do things faster, thanks!

While I can understand not wanting to roll your own code to accomplish this from dirt (i.e. String operations in VB code), this approach is probably worse than you could do in pure VB6. XSL is notoriously slow and the XSLT engine itself is tremendously bulky. Try testing with a 750KB XML document!


An obvious alternative if you are already loading an MSXML library is to use the SAX2 objects. They can make this is trivial matter, and do the entire thing far faster using far less memory.

Here is 100% of the code in this demo, and you can basically ignore everything outside of cmdReformat_Click:

Option Explicit

Private Sub ManageUI()
    'Make UI changes based on the relationships of controls and their
    'curent values.
    chkStandalone.Enabled = chkOmitXMLDeclaration.Value <> vbChecked
End Sub

Private Sub chkOmitXMLDeclaration_Click()
    ManageUI
End Sub

Private Sub cmdReformat_Click()
    Dim rdrCompact As MSXML2.SAXXMLReader
    Dim wrtFormatted As MSXML2.MXXMLWriter

    Set wrtFormatted = New MSXML2.MXXMLWriter
    With wrtFormatted
        .omitXMLDeclaration = chkOmitXMLDeclaration.Value = vbChecked
        .standalone = chkStandalone.Value = vbChecked
        .indent = chkIndent.Value = vbChecked
        .output = "" 'Tells MXXMLWriter we want Unicode String output.
        Set rdrCompact = New MSXML2.SAXXMLReader
        With rdrCompact
            Set .contentHandler = wrtFormatted
            Set .dtdHandler = wrtFormatted
            Set .errorHandler = wrtFormatted
            .putProperty "http://xml.org/sax/properties/lexical-handler", _
                         wrtFormatted
            .putProperty "http://xml.org/sax/properties/declaration-handler", _
                         wrtFormatted
            .parse txtOriginal.Text
        End With
        txtPrettied.Text = .output
    End With
End Sub

Private Sub Form_Load()
    ManageUI
End Sub