Validating FileSystem Structure

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:

• Retrieve lists of expected Drives/Folders

-
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

-
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

• 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] ->
'

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.

StackExchange Code Review Q#136192, answer score: 3