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]


Dictionary of expected Drives (currently 1)

Dictionary of expected RootFolders (currently 1)

Dictionary of expected Adviser Folders

Dictionary of expected Business Type Folders

Code for the above not included.

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


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


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 currentDrive As Drive     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 


Category: vba Time: 2016-07-28 Views: 0

Related post

iOS development

Android development

Python development

JAVA development

Development language

PHP development

Ruby development


Front-end development


development tools

Open Platform

Javascript development

.NET development

cloud computing


Copyright (C), All Rights Reserved.

processed in 0.211 (s). 12 q(s)