List All SubFolders of a Path in an Access Table

[EastWind]

I wanted to post this because this site helps to keep me sane in my job. I hope this is useful to someone else out there...

I recently wanted to list all of the VBA names of all references that existed on my C:\ drive. In order to do that, I would need to search for all files in all subfolders of C:\ for files with one of eleven extensions (e.g. .mdb, .lib, .exe, .olb, etc.), list them in a table, attempt to add them to the current database as a reference and then list the VBA name and path of all references in the table. The following code gives the two subprocedures needed to spin through the passed pathname's subfolders and list them in the pre-created tables SubFolderPath and errFileExt.

Private Sub SubFldrOfFldr(SFName As String)
'''''''''''''''''''''''''''''''''''''''''''''''''''''
'Determine all subfolders of the path string SFName.'
'''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim n As Integer, CounterExt As Integer, CounterInt As Integer
Dim SubTblCount As Integer, SubFolderCount As Integer
LoadSubFolders 0, SFName
    For CounterExt = 1 To DCount("PK", "SubFolderPath")
        SubTblCount = DCount("PK", "SubFolderPath")
        CounterInt = CounterExt
        SubFolderCount = LoadSubFolders(CounterInt, _
                        DLookup("Sub_Folder_Path", "SubFolderPath", "PK=" & CounterInt))
        
    Do While SubFolderCount < SubTblCount
        SFName = DLookup("Sub_Folder_Path", "SubFolderPath", "PK=" & CounterInt)
        SubFolderCount = LoadSubFolders(CounterInt, SFName)
        CounterInt = CounterInt + 1
    Loop
   
   Next CounterExt
End Sub

The referenced subprocedure LoadSubFolders:

Public Function LoadSubFolders(Counter As Integer, FolderPath As String) As Integer
On Error GoTo LoadSubFolders_Err
Dim fs As FileSystemObject, f As Folders, SubName As Folder
Dim Statement As String
'''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Put the list of subfolders into Tables!SubFolderPath.'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.GetFolder(FolderPath).SubFolders
    LoadSubFolders = Counter
    
    For Each SubName In f
        LoadSubFolders = LoadSubFolders + 1
        If TestSubFldrInTable(SubName.Path) = False Then
            Statement = "INSERT INTO SubFolderPath (Sub_Folder_Path) SELECT '" _
                        & SubName.Path & "';"
            DoCmd.RunSQL (Statement)
        End If
    Next SubName
    
Exit Function

LoadSubFolders_Err:
    Statement = "INSERT INTO errFileExt (Path_File_Name, ProbType) " _
            & "SELECT '" & FolderPath & "', 'Load';"
    DoCmd.RunSQL (Statement)
    
End Function

And, the final referenced function TestSubFldrInTable:

Private Function TestSubFldrInTable(SubNamePath As String) As Boolean
Dim n As Integer, Counter As Integer, sfPath As String
'''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Return True if this subfolder path is already in the '
'SubFolderPath table; False, if it is not.            '
'''''''''''''''''''''''''''''''''''''''''''''''''''''''
    n = DCount("Sub_Folder_Path", "SubFolderPath")
    If n > 0 Then
        For Counter = 1 To n
            sfPath = DLookup("Sub_Folder_Path", "SubFolderPath", "PK=" & Counter)
            If SubNamePath = sfPath Then
                TestSubFldrInTable = True
                Exit Function
            Else:
                TestSubFldrInTable = False
            End If
        Next Counter
    End If
End Function