VBA - RecursiveExplorerWindows class - allows opening (and closing) of directory structures

So I wanted a class to open Windows Explorer windows on specific folders and then also the subfolders. Then I found some code I had written could not progress without those windows being closed. So I wrote some more code to close off all windows in a directory structure. Below is the code.

Much of this is standard. The UnExploreThisFolder method is quite interesting it uses the Microsoft Shell Controls and Automation type library to loop through windows to see if they need closing; the is a slight bug in their enumerator that does not like deletions midway through a loop so we handle that by starting a new enumeration.

The RecursiveExplorerWindows class

Option Explicit

'Class module RecursiveExplorerWindows

'*Tools->References
' *** Microsoft Scripting Runtime
' *** Microsoft Shell Controls and Automation

Private mfso As New Scripting.FileSystemObject

Public Sub OpenFolderAndAllSubfolder(ByVal sFolder As String)

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

End Sub

Private Sub OpenFolderAndAllSubfolder2(ByVal oFolder As Scripting.Folder)
    
    If Not oFolder Is Nothing Then
    
        ExploreThisFolder oFolder.Path
        
        Dim oFolderLoop As Scripting.Folder
        For Each oFolderLoop In oFolder.SubFolders
            
            OpenFolderAndAllSubfolder2 oFolderLoop
        
        Next

    End If

End Sub

Public Sub CloseFolderAndAllSubfolder(ByVal sFolder As String)

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

End Sub


Private Sub CloseFolderAndAllSubfolder2(ByVal oFolder As Scripting.Folder)
    
    If Not oFolder Is Nothing Then
    
        UnExploreThisFolder oFolder.Path
        
        Dim oFolderLoop As Scripting.Folder
        For Each oFolderLoop In oFolder.SubFolders
            
            CloseFolderAndAllSubfolder2 oFolderLoop
        
        Next

    End If

End Sub


Public Sub ExploreThisFolder(ByVal sFolder As String)
    Shell "explorer.exe " & sFolder, vbNormalFocus
End Sub

Public Sub UnExploreThisFolder(ByVal sFolder As String)


    Dim bFullFolder As Boolean
    bFullFolder = mfso.FolderExists(sFolder)

    Dim sComparableProperty As String
    sComparableProperty = VBA.IIf(bFullFolder, "LocationURL", "LocationName")
    
    Dim sCompareValue As String: sCompareValue = vbNullString
    If bFullFolder Then
        If Right$(sCompareValue, 1) = "\" Then
            sCompareValue = Left$(sCompareValue, Len(sCompareValue) - 1)
        End If
    
        sCompareValue = "file:///" & Replace(sFolder, "\", "/", 1)
    Else
        sCompareValue = sFolder
    End If


    Dim bNoMoreToClose As Boolean
    bNoMoreToClose = True

    Dim oShell As Shell32.Shell
    Set oShell = New Shell32.Shell
    
    Dim wins As Object 'Shell32.Windows
    Set wins = oShell.Windows
    
    '* the enumerator does not handle deletions midway thru loop very well
    '* if we delete one then we need to go again and reset the enumerator, *sigh*
    
    While bNoMoreToClose
        
        bNoMoreToClose = False
        DoEvents
    
        Dim winLoop As Variant
        For Each winLoop In oShell.Windows
            Dim sLoopCompareValue As String
            sLoopCompareValue = CallByName(winLoop, sComparableProperty, VbGet)
            
            If StrComp(sLoopCompareValue, sCompareValue) = 0 Then
            'If winLoop.LocationName = sCompareValue Then
                winLoop.Quit
                bNoMoreToClose = True
            End If
        Next
    Wend
End Sub

The tstTestRecursiveExplorerWindows standard (test) module

Option Explicit
Option Private Module

'standard module tstTestRecursiveExplorerWindows

'*Tools->References
' *** Microsoft Scripting Runtime

Private mfso As New Scripting.FileSystemObject

Private Sub TestExploreThisFolder()
    Dim oRecursiveExplorerWindows As RecursiveExplorerWindows
    Set oRecursiveExplorerWindows = New RecursiveExplorerWindows

    Dim s As String
    s = Environ$("userprofile") & "\AppData\Local\Temp\VBAEquivOfOpenXML\Book1\"
    
    Debug.Assert mfso.FolderExists(s)
    
    oRecursiveExplorerWindows.ExploreThisFolder s
End Sub

Private Sub TestUnexploreThisFolder_FullFolder()
    Dim oRecursiveExplorerWindows As RecursiveExplorerWindows
    Set oRecursiveExplorerWindows = New RecursiveExplorerWindows

    Dim s As String
    s = Environ$("userprofile") & "\AppData\Local\Temp\VBAEquivOfOpenXML\Book1\"
    
    Debug.Assert mfso.FolderExists(s)
    
    oRecursiveExplorerWindows.UnExploreThisFolder s
End Sub

Private Sub TestUnexploreThisFolder_LeafFolderName()
    Dim oRecursiveExplorerWindows As RecursiveExplorerWindows
    Set oRecursiveExplorerWindows = New RecursiveExplorerWindows

    
    oRecursiveExplorerWindows.UnExploreThisFolder "Downloads"
    oRecursiveExplorerWindows.UnExploreThisFolder "Book1"
End Sub

Private Sub TestOpenFolderAndAllSubfolder()
    Dim oRecursiveExplorerWindows As RecursiveExplorerWindows
    Set oRecursiveExplorerWindows = New RecursiveExplorerWindows

    Dim s As String
    s = Environ$("userprofile") & "\AppData\Local\Temp\VBAEquivOfOpenXML\Book1\"
    
    Debug.Assert mfso.FolderExists(s)
    
    oRecursiveExplorerWindows.OpenFolderAndAllSubfolder s
End Sub

Private Sub TestCloseFolderAndAllSubfolder()
    Dim oRecursiveExplorerWindows As RecursiveExplorerWindows
    Set oRecursiveExplorerWindows = New RecursiveExplorerWindows

    Dim s As String
    s = Environ$("userprofile") & "\AppData\Local\Temp\VBAEquivOfOpenXML\Book1\"
    
    Debug.Assert mfso.FolderExists(s)
    
    oRecursiveExplorerWindows.CloseFolderAndAllSubfolder s
End Sub