Home > How-To Library > XML Handling

Indent XML Code

****************************************************************
*       © 2007 CodeItBetter http://www.codeitbetter.com        *
*          This notice MUST stay intact for legal use          *
****************************************************************

Sub oIndentXml(oXMLfile As String)
    On Error Resume Next
    ''This procedure is used to indent XML document
    '' <Family>
    ''    <Member Relationship="Father">
    ''       <Name>Some Guy</Name>
    ''    </Member>
    '' </Family>
    '' Requires msxml.dll (Go to Project --> References and and choose Microsoft
    '' XML version 2.0, or whatever the
    '' current version you have installed)
    Dim oXSLT As DOMDocument
    Dim XSL_FILE As String
    Dim sResult As String
    Const DoubleQuotes = """"
    Dim strText As String
    Dim objDom As DOMDocument

    Set objDom = New DOMDocument

    Open oXMLfile For Input As #1
    strText = Input$(LOF(1), #1)
    Close #1

    objDom.loadXML strText

    Set oXSLT = New DOMDocument
    XSL_FILE = "<?xml version=" & DoubleQuotes & "1.0" & DoubleQuotes & " encoding=" & DoubleQuotes _
        & "UTF-8" & DoubleQuotes & "?>" & vbCrLf & "<xsl:stylesheet version=" & DoubleQuotes & "1.0" _
        & DoubleQuotes & " xmlns:xsl=" & DoubleQuotes & "http://www.w3.org/1999/XSL/Transform" _
        & DoubleQuotes & ">" & vbCrLf & "     <xsl:output method=" & DoubleQuotes & "xml" & DoubleQuotes _
        & " version=" & DoubleQuotes & "1.0" & DoubleQuotes & " encoding=" & DoubleQuotes & "UTF-8" _
        & DoubleQuotes & " indent=" & DoubleQuotes & "yes" & DoubleQuotes & "/>" & vbCrLf & _
        "     <xsl:template match=" & DoubleQuotes & "@* | node()" & DoubleQuotes & ">" & vbCrLf & _
        "          <xsl:copy>" & vbCrLf        & "               <xsl:apply-templates select=" & DoubleQuotes & _
        "@* | node()" & DoubleQuotes & " />" & vbCrLf & "          </xsl:copy>" & vbCrLf & "     </xsl:template>" _
        & vbCrLf & "</xsl:stylesheet>"
    objDom.async = False
    oXSLT.async = False
    oXSLT.loadXML XSL_FILE
    If oXSLT.parseError.errorCode = 0 Then
        If oXSLT.readyState = 4 Then
            sResult = objDom.transformNode(oXSLT.documentElement)
            sResult = Replace$(sResult, "<?xml version=" & DoubleQuotes & "1.0" & DoubleQuotes & " encoding=" _
                & DoubleQuotes & "UTF-16" & DoubleQuotes & "?>", vbNullString, , , vbTextCompare)
            objDom.loadXML sResult
        End If
    Else
        Debug.Print Err.Description = oXSLT.parseError.reason & vbCrLf & "Line: " & oXSLT.parseError.Line & vbCrLf _
            & "XML: " & oXSLT.parseError.srcText
        'Err.Raise 1006
        Err.Clear
    End If

    strText = objDom.xml

    'open the file to save added headers after indenting the code
    Open oXMLfile For Output As #1
    Print #1, strText
    Close #1

ExitHere:
    Err.Clear
    Set oXSLT = Nothing
    Set objDom = Nothing
End Sub

If you would like to submit your code here please us. Do not forget to mention your name. We are always thankful to each and everyone of you who submitted their code here.