VBA - RecursiveXmlPrettifier class - recursively prettify all xml files in a subdirectory

So I gave some code to prettify xml content 2017 Q4. With some extra code given here today we can write a class to iterate through a directory and all subdirectories prettifying all the xml files it finds. That is the RecursiveXmlPrettifier class.

The RecursiveXmlPrettifier class

Option Explicit

'Class module RecursiveXmlPrettifier


'*Tools->References
' *** Microsoft Scripting Runtime
' *** Microsoft XML, v6.0


Private mfso As New Scripting.FileSystemObject

Public Sub PrettyPrintAllInFolder(ByVal sFolder As String)

    If mfso.FolderExists(sFolder) Then
    
        PrettyPrintAllTheXmlFilesInThisFolder mfso.GetFolder(sFolder)
    
    End If


End Sub

Private Sub PrettyPrintAllTheXmlFilesInThisFolder(ByVal oFolder As Scripting.Folder)
    
    If Not oFolder Is Nothing Then
    
        Dim oFilLoop As Scripting.File
        For Each oFilLoop In oFolder.Files
            If StrComp(Right$(oFilLoop.Name, 4), ".xml", vbTextCompare) = 0 Then
                PrettifyThisFile oFilLoop.Path
            End If
            
            '* and for bug in Open XML hwerwethere is a file under \xl\_rels called workbook.xml.rels or under \_rels\.rels
            If StrComp(oFolder.Name, "_rels", vbTextCompare) = 0 Then
                If StrComp(oFilLoop.Name, "workbook.xml.rels", vbTextCompare) = 0 Then
                    PrettifyThisFile oFilLoop.Path, True
                End If
            End If
            
            '* or under \xl\_rels called workbook.xml.rels or under \_rels\.rels
            If StrComp(oFolder.Name, "_rels", vbTextCompare) = 0 Then
                If StrComp(oFilLoop.Name, ".rels", vbTextCompare) = 0 Then
                    PrettifyThisFile oFilLoop.Path, True
                End If
            End If
            
        Next oFilLoop
        
        Dim oFolderLoop As Scripting.Folder
        For Each oFolderLoop In oFolder.SubFolders
            
            PrettyPrintAllTheXmlFilesInThisFolder oFolderLoop
        
        Next

    End If

End Sub


Public Sub PrettifyThisFile(ByVal sFile As String, Optional bSkipExtensionCheck As Boolean)

    If Len(sFile) >= 4 Then
    
        Dim bProceed As Boolean
        bProceed = True
        
        '* extra logic to handle Open Xml bug
        If bSkipExtensionCheck = False Then bProceed = StrComp(Right$(sFile, 4), ".xml", vbTextCompare) = 0
        
        If bProceed Then
    
            If mfso.FileExists(sFile) Then
            
                Dim dom As MSXML2.DOMDocument60
                Set dom = New MSXML2.DOMDocument60
                dom.Load sFile
                If dom.parseError.ErrorCode = 0 Then
                    dom.LoadXML PrettyPrintXml(dom)
                    If dom.parseError.ErrorCode = 0 Then
                        dom.Save sFile
                    Else
                        Debug.Print "parse fail on pretttifying"
                    End If
                Else
                    Debug.Print "parse fail on load"
                End If
            
            End If
        End If
    End If

End Sub

Public Function PrettyPrintXml(ByVal dom As MSXML2.DOMDocument60) As String

    Dim reader As MSXML2.SAXXMLReader60
    Set reader = New MSXML2.SAXXMLReader60
    
    Dim writer As MSXML2.MXXMLWriter60
    Set writer = New MSXML2.MXXMLWriter60
    writer.omitXMLDeclaration = True
    writer.indent = True
    
    reader.PutProperty "http://xml.org/sax/properties/lexical-handler", writer

    Set reader.contentHandler = writer
    reader.Parse dom.XML
   
    PrettyPrintXml = writer.output
End Function

The tstTestRecursiveXmlPrettifier standard (test) module

Option Explicit
Option Private Module

'*Tools->References
' *** Microsoft Scripting Runtime
' *** Microsoft XML, v6.0

Private mfso As New Scripting.FileSystemObject

Private Sub TestPrettyPrintAllTheXmlFiles()
    Dim oRecursiveXmlPrettifier As RecursiveXmlPrettifier
    Set oRecursiveXmlPrettifier = New RecursiveXmlPrettifier

    Dim s As String
    s = Environ$("userprofile") & "\AppData\Local\Temp\VBAEquivOfOpenXML\Book1\"
    
    Debug.Assert mfso.FolderExists(s)
    
    oRecursiveXmlPrettifier.PrettyPrintAllInFolder s


End Sub



Private Sub TestPrettifyThisFile()

    Dim oRecursiveXmlPrettifier As RecursiveXmlPrettifier
    Set oRecursiveXmlPrettifier = New RecursiveXmlPrettifier

    Dim s As String
    s = Environ$("userprofile") & "\AppData\Local\Temp\VBAEquivOfOpenXML\Book1\[Content_Types].xml"
    
    Debug.Assert mfso.FileExists(s)
    
    oRecursiveXmlPrettifier.PrettifyThisFile s
    
End Sub