Validating FileSystem Structure

Question

I have a File System. It is *supposed* to be laid out / used / added to in certain ways.

This is a program to report on the *actual* state of the file system versus what it's supposed to be.

In particular, pick out unexpected folders and (eventually) validate that Client Folder Names follow a particular convention.

---

Expected File Structure:

[Drives] ->
[Root folders] ->
[Adviser Folders] ->
[Type Of Business Folders] ->
[Client Folders]

---

Components:

GetRootDrives()
Dictionary of expected Drives (currently 1)

GetRootFolderNames()
Dictionary of expected RootFolders (currently 1)

GetAdviserFolderNames()
Dictionary of expected Adviser Folders

GetBusinessTypeFolderNames()
Dictionary of expected Business Type Folders

Code for the above not included.

GetDirectoryMap()
Returns a list of CLS_Client_Folder_Properties objects.
One for every unexpected folder. One for every Client Folder.

Code for CLS_Client_Folder_Properties not included

---

Program Flow:

1. Retrieve lists of expected Drives/Folders

2. Iterate through folders

   If the folder is not in the relevant list, create a partial folder_properties object and add to return list

   If the folder is in the relevant list, iterate through the Sub Folders

3. Once we get to a folder expected to contain client files, iterate over each sub folder, creating a folder_properties object for each and add to return list

4. Return the list

---

Concerns

This feels very hacky. It's a 6-level nested For/If Loop. There must be a better way.

---

Code

Option Explicit

Public Function GetLuminDirectoryMap() As Variant

    '/ All directories should be stored in the form "[Directory Name][Delimiter]" E.G. "SomeDirectory\"

    '/ Assumed Directory Structure: [Drives] ->
    '/                              [Root Directories] ->
    '/                              [Adviser Directories] ->
    '/                              [Type of Business Directories] ->
    '/                              [Client Folders]

    '/ Program Flow:
    '/
    '/ Get Dictionaries for starting Drives/Root Directories and for expected Adviser/Type Of Business folder names
    '/ For each combination of the above:
    '/
    '/ Parse Sub Folders
    '/
    '/ If is expected directory, Parse Sub Folders
    '/
    '/ Else create partial client folder properties object with "IsValid" = false, add to return list
    '/
    '/ Repeat until we get to a valid type of business folder containing client folders
    '/
    '/ Then, for each client folder, create client folder properties object, add to return list

    Dim directoryMap As Variant '/ our return array, list of CLS_Client_Folder_Properties objects

    Dim currentFileSystem As FileSystemObject
    Set currentFileSystem = New FileSystemObject

    Dim driveName As Variant
    Dim rootDrives As Dictionary
    Set rootDrives = GetRootDrives

    Dim RootFolderName As Variant
    Dim rootFolderNames As Dictionary
    Set rootFolderNames = GetRootFolderNames

    Dim AdviserFolderName As Variant
    Dim adviserFolderNames As Dictionary
    Set adviserFolderNames = GetAdviserFolderNames

    Dim businessTypeFolderName As Variant
    Dim businessTypeFolderNames As Dictionary
    Set businessTypeFolderNames = GetBusinessTypeFolderNames

    Dim currentRootFolder As Folder
    Dim currentAdviserFolder As Folder
    Dim currentTypeFolder As Folder
    Dim currentClientFolder As Folder

    Dim isValidFolder As Boolean
    Dim folderProperties As CLS_Client_Folder_Properties

    For Each driveName In rootDrives.Keys()
        For Each RootFolderName In rootFolderNames.Keys()
            Set currentRootFolder = currentFileSystem.GetFolder(driveName & RootFolderName)

            For Each currentAdviserFolder In currentRootFolder.SubFolders
                AdviserFolderName = currentAdviserFolder.Name
                isValidFolder = adviserFolderNames.Exists(AdviserFolderName & "\")

                If isValidFolder Then

                    For Each currentTypeFolder In currentAdviserFolder.SubFolders
                        businessTypeFolderName = currentTypeFolder.Name
                        isValidFolder = businessTypeFolderNames.Exists(businessTypeFolderName & "\")

                        If isValidFolder Then

                            For Each currentClientFolder In currentTypeFolder.SubFolders
                                ExtendAndFill directoryMap, CreateFolderProperties(isValidFolder, driveName, RootFolderName, AdviserFolderName, businessTypeFolderName, currentClientFolder.Name)
                            Next currentClientFolder

                        Else
                            ExtendAndFill directoryMap, CreateFolderProperties(isValidFolder, driveName, RootFolderName, AdviserFolderName, businessTypeFolderName)
                        End If
                    Next currentTypeFolder

                Else
                    ExtendAndFill directoryMap, CreateFolderProperties(isValidFolder, driveName, RootFolderName, AdviserFolderName)
                End If
            Next currentAdviserFolder

        Next RootFolderName
    Next driveName

    GetLuminDirectoryMap = directoryMap

End Function

Public Sub ExtendAndFill(ByRef listArray As Variant, ByVal var As Variant)

    If IsEmpty(listArray) Then
        ReDim listArray(1 To 1)
        If IsObject(var) Then Set listArray(1) = var Else listArray(1) = var
    Else
        Dim LB1 As Long
        Dim UB1 As Long
        AssignArrayBounds listArray, LB1, UB1

        ReDim Preserve listArray(LB1 To UB1 + 1)
        If IsObject(var) Then Set listArray(UB1 + 1) = var Else listArray(UB1 + 1) = var
    End If

End Sub

Public Function CreateFolderProperties(Optional ByVal isValid As Boolean = False, Optional ByVal driveName As String = vbNullString, Optional ByVal rootFolderName As String = vbNullString _
                                    , Optional ByVal adviserFolderName As String = vbNullString, Optional ByVal typeOfBusinessFolderName As String = vbNullString _
                                    , Optional ByVal clientFolderName As String = vbNullString) _
                                    As CLS_Client_Folder_Properties

    Dim folderProperties As CLS_Client_Folder_Properties
    Set folderProperties = New CLS_Client_Folder_Properties

    With folderProperties
        .IsValid = IsValid
        .driveName = driveName
        .RootFolderName = RootFolderName
        .AdviserFolderName = AdviserFolderName
        .TypeOfBusinessFolderName = TypeOfBusinessFolderName
        .ClientFolderName = ClientFolderName
    End With

    Set CreateFolderProperties = folderProperties

End Function

Answer 1

There are several things I don't know about your code and format of the data - in particular what's exactly stored in the Dictionary returned by GetRootNames, GetRootFolderNames, etc. In my example below, each of those dictionary keys stores the full path to a folder (so you'll have to make adjustments for your own situation). But I'm hoping the example below can show what I meant about using recursion to (perhaps) simplify your code.

Option Explicit

Sub test()
    Dim clientFolderProperties As Variant
    clientFolderProperties = GetDirectoryMap

    Dim clients() As String
    clients = Split(CStr(clientFolderProperties), ",", , vbTextCompare)

    Dim i As Integer
    For i = 1 To UBound(clients, 1) Step 2
        Debug.Print "client folder: " & clients(i)
    Next i
End Sub

Public Function GetDirectoryMap() As Variant
    '--- returns a list of client folders that appear at any
    '    level of a directory tree
    Dim directoryMap As Variant
    Dim clientFolderStructure As Dictionary
    Set clientFolderStructure = GetDirDictionary

    '--- loop over the list of drives
    Dim driveName As Variant
    Dim rootDrives As Dictionary
    Set rootDrives = GetRootDrives

    Dim currentFileSystem  As Scripting.FileSystemObject
    Set currentFileSystem = New Scripting.FileSystemObject

    Dim rootFolder As Scripting.Folder
    For Each driveName In currentFileSystem.Keys()
        Set rootFolder = rootFSO.GetFolder(driveName)
        MapClientFolders rootFolder, 0, clientFolderStructure, directoryMap
    Next driveName
    If Right(directoryMap, 1) = "," Then
        directoryMap = Left(directoryMap, Len(directoryMap) - 1)
    End If
    GetDirectoryMap = directoryMap
End Function

Private Sub MapClientFolders(ByVal thisFolder As Scripting.Folder, _
                             ByVal level As Integer, _
                             ByRef dirDict As Dictionary, _
                             ByRef folderList As Variant)
    Dim subFolder As Scripting.Folder
    For Each subFolder In thisFolder.SubFolders
        If (Not dirDict.Exists(subFolder)) Or _
           (dirDict.Item(subFolder) <> level) Then
            '--- the folder isn't listed at all in the approved
            '    directory structure, so note it --OR--
            '    this subfolder exists in the approved structure,
            '    but it's at the wrong level
            folderList = folderList & subFolder & ","
        Else
            '--- this subfolder is in the right place, so
            '    continue checking down the tree
            MapClientFolders subFolder, level + 1, dirDict, folderList
        End If
    Next subFolder
End Sub

Private Function GetDirDictionary() As Dictionary
    '--- returns a single dictionary object with the various
    '    file structure folders identified per level
    '    **ASSUMES that the original folder dictionaries use the
    '    **folder name as the key and does not store a data value
    Dim dirDictionary As Dictionary
    Set dirDictionary = New Dictionary
    AppendDictionary dirDictionary, GetRootFolderNames, 1
    AppendDictionary dirDictionary, GetAdviserFolderNames, 2
    AppendDictionary dirDictionary, GetBusinessTypeFolderNames, 3
    Set GetDirDictionary = dirDictionary
End Function

Private Sub AppendDictionary(ByRef baseDict As Dictionary, _
                             ByRef externalDict As Dictionary, _
                             ByVal level As Integer)
    Dim folderName As Variant
    For Each folderName In externalDict.Keys
        baseDict.Add folderName, level
    Next folderName
End Sub

Private Function GetRootDrives() As Dictionary
    Dim newDict As Dictionary
    Set newDict = New Dictionary
    newDict.Add "C:\Temp", 99
    Set GetRootDrives = newDict
End Function

Private Function GetRootFolderNames() As Dictionary
    Dim newDict As Dictionary
    Set newDict = New Dictionary
    newDict.Add "C:\Temp\Advisor-1", 99
    newDict.Add "C:\Temp\Advisor-2", 99
    Set GetRootFolderNames = newDict
End Function

Private Function GetAdviserFolderNames() As Dictionary
    Dim newDict As Dictionary
    Set newDict = New Dictionary
    newDict.Add "C:\Temp\Advisor-1\A1-BT1", 99
    newDict.Add "C:\Temp\Advisor-1\A1-BT2", 99
    newDict.Add "C:\Temp\Advisor-2\A2-BT1", 99
    Set GetAdviserFolderNames = newDict
End Function

Private Function GetBusinessTypeFolderNames() As Dictionary
    Dim newDict As Dictionary
    Set newDict = New Dictionary
    newDict.Add "C:\Temp\Advisor-1\A1-BT1\A1-BT1-C1", 99
    newDict.Add "C:\Temp\Advisor-1\A1-BT1\A1-BT1-C2", 99
    Set GetBusinessTypeFolderNames = newDict
End Function

The results printed from the Test sub should display the folders not found in the "approved client folder structure". At least this can give you an idea of what's possible in your situation.

Answer 2

One small but sometimes helpful neat approach, without refactoring your code, is to use a kind of 'continue' statement.

Sample:

For Each foo In bar: Do
    '...
    If AnyCondition() Then Exit Do 'Continue
    '...
Loop While False: Next foo

Using this helps to reduce your arrow code by two levels:

For Each driveName In rootDrives.Keys()
    For Each RootFolderName In rootFolderNames.Keys()
        Set currentRootFolder = currentFileSystem.GetFolder(driveName & RootFolderName)

        For Each currentAdviserFolder In currentRootFolder.SubFolders: Do
            AdviserFolderName = currentAdviserFolder.Name
            isValidFolder = adviserFolderNames.Exists(AdviserFolderName & "\")

            If Not isValidFolder Then
                ExtendAndFill directoryMap, CreateFolderProperties(isValidFolder, driveName, RootFolderName, AdviserFolderName)
                Exit Do 'Continue
            End If

            For Each currentTypeFolder In currentAdviserFolder.SubFolders: Do
                businessTypeFolderName = currentTypeFolder.Name
                isValidFolder = businessTypeFolderNames.Exists(businessTypeFolderName & "\")

                If Not isValidFolder Then
                    ExtendAndFill directoryMap, CreateFolderProperties(isValidFolder, driveName, RootFolderName, AdviserFolderName, businessTypeFolderName)
                    Exit Do 'Continue
                End If

                For Each currentClientFolder In currentTypeFolder.SubFolders
                    ExtendAndFill directoryMap, CreateFolderProperties(isValidFolder, driveName, RootFolderName, AdviserFolderName, businessTypeFolderName, currentClientFolder.Name)
                Next currentClientFolder

            Loop While False Next currentTypeFolder

        Loop While False: Next currentAdviserFolder

    Next RootFolderName
Next driveName