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

• pacmaninbw: 6 levels of indentation generally indicates a function/subroutine is needed.
• Kaz: @pacmaninbw Yes. Hence the question.
• PeterT: Couldn't this be accomplished with a "simpler" recursive function? The complication would be how to store the folder tree as it traverses each branch.
• Kaz: @PeterT I did think about it. Haven't been able to figure out a good way so far.
• Comintern: I thought I'd take a stab at this, but it isn't clear from your code what is contained in the dictionaries. Are they always full paths (i.e. you might have a rootFolderName value of "C:\Root\" and an adviserFolderName value of "C:\Root\Advisor\") or are they path parts (i.e. a rootFolderName value of "Root" and an adviserFolderName of "Advisor")?

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

• t3chb0t: For Each foo In bar: Do wow, I didn't know this trick. Nice.