Solved Access VBA - Loop through files in Folders, Subfolders, Sub-Sub Folders....

ironfelix717

Registered User.
Local time
Yesterday, 23:28
Joined
Sep 20, 2019
Messages
193
Hi,

Before I write my own nested nested nested loop, surely someone has something out there already....

I need to list all the files in a single 'base' folder, which includes subfolders of the base folder. and subfolders of the subfolder's subfolders. The nesting of the subfolders is assumed to be unkown, therefore, I need code that can adapt to the very bottom level of each sub-sub-sub-sub...folder.

You get the idea.. ( i think ).

All the examples i've seen go to 2 or 3 tiers down, but don't seem to be recursive to search at the very bottom level of a folder.


Other info: If necessary, we can assume practically that the maximum "nesting" is 4 tiers of subfolders below the root.


Thanks
 
there are "a lot" on the net.
 
>> I need code that can adapt to the very bottom level of each sub-sub-sub-sub...folder. <<

Research 'recursive function'
 
This shows two types of recursion. First it does the span of a folder and logs the file and folder information into a table.
Then does recursion using the table of logged information (each entry references a parent record in the table) to load the tree view. (You can disregard the treeview code if not interested)

Here is the file span stripped to the essentials.
Code:
Private FSO As FileSystemObject
Public Sub InitializeSpan()
  Set FSO = New FileSystemObject
  SpanFolders GetDefaultFolderPath  ' Need to pass in the startfolder. GetDefaultFolderPath is a custom function
  Set FSO = Nothing
End Sub

Private Sub SpanFolders(SourceFolderFullName As String)

    Dim SourceFolder As Scripting.Folder 'Scripting.Folder
    Dim SubFolder As Scripting.Folder 'Scripting.Folder
    Dim FileItem As Scripting.file 'Scripting.File
   
    Set SourceFolder = FSO.GetFolder(SourceFolderFullName)
   
       For Each FileItem In SourceFolder.Files
        'Custom method to save these properties to a table
        ' LogFilesFolders FileItem.Name, FileItem.Path, FileItem.Type, ParentID, fft_File, FolderLevel
      Next FileItem
   
    For Each SubFolder In SourceFolder.SubFolders
     'Another custom method to save folder information
     ' LogFilesFolders SubFolder.Name, SubFolder.Path, SubFolder.Type, ParentID, fft_Folder, FolderLevel
     'Here is the recursive Call
      SpanFolders SubFolder.Path, ParentID, FolderLevel
    Next SubFolder

    Set FileItem = Nothing
    Set SourceFolder = Nothing

End Sub

Files.jpg
 

Attachments

Hi,

Thanks for the replies.

So far, I've attempted to use @arnelgp and @theDBguy solution.

Both cases did not work. Providing the correct arguments (trailing slash in path name, proper asterisk notation for filespec).


I find it highly coincidental that both of those functions would not work, but they... don't. They begin to loop through some files, but ultimately the recursion overwrites itself at some point in the file system. Don't have time to troubleshoot those right now but I had zero success with them.

@theDBguy
Code:
Dim fpath As String
fpath = "\\Drive\Home\Desktop\"
Debug.Print Len(ListFiles(fpath))  'returns zero every time, fpath is valid and has several files


@arnelgp
Code:
Dim fpath As String
Dim col     As New Collection

fpath = "\\Drive\Home\Desktop\"

Set col = RecursiveDir(col, fpath, "*.*", True)

Debug.Print col.count
  'returns zero every time, fpath is valid and has several files/folders


Will be looking around at the other suggestions in the mean time.
 
Hi,

Thanks for the replies.

So far, I've attempted to use @arnelgp and @theDBguy solution.

Both cases did not work. Providing the correct arguments (trailing slash in path name, proper asterisk notation for filespec).


I find it highly coincidental that both of those functions would not work, but they... don't. They begin to loop through some files, but ultimately the recursion overwrites itself at some point in the file system. Don't have time to troubleshoot those right now but I had zero success with them.

@theDBguy
Code:
Dim fpath As String
fpath = "\\Drive\Home\Desktop\"
Debug.Print Len(ListFiles(fpath))  'returns zero every time, fpath is valid and has several files


@arnelgp
Code:
Dim fpath As String
Dim col     As New Collection

fpath = "\\Drive\Home\Desktop\"

Set col = RecursiveDir(col, fpath, "*.*", True)

Debug.Print col.count
  'returns zero every time, fpath is valid and has several files/folders


Will be looking around at the other suggestions in the mean time.
Hi. Sorry to hear that. Just a quick question though, when you say "it didn't work," was there any error message?
 
Hi. Sorry to hear that. Just a quick question though, when you say "it didn't work," was there any error message?

Code:
Dim fpath As String
fpath = "\\Drive\Home\Desktop\"
Debug.Print Len(ListFiles(fpath))  'returns zero every time, fpath is valid and has several files
 
Code:
Dim fpath As String
fpath = "\\Drive\Home\Desktop\"
Debug.Print Len(ListFiles(fpath))  'returns zero every time, fpath is valid and has several files
What if you try a local or mapped drive? Just curious...
 
What if you try a local or mapped drive? Just curious...
Hi, I tried several folders on a mapped drive. But I don't suspect this to be the issue. I haven't had a problem with any FSO functions or built-in file system functions in VBA yet with my mapped drive. Will report back if I do more testing. Thanks.
 
Hi, I tried several folders on a mapped drive. But I don't suspect this to be the issue. I haven't had a problem with any FSO functions or built-in file system functions in VBA yet with my mapped drive. Will report back if I do more testing. Thanks.
Okay. Without an error message, it's hard to say why it wasn't working. Good luck!
 
@theDBguy
Its not a runtime error. Its simply faulty in my case and returns nothing. Thanks



Also,

@arnelgp
Post #9 reflects your code converted to a function, rather than a sub. (It doesn't make much sense to not return a value if you're going to pass input args to the sub)
But apparently, I am not returning the correct collection or something.
 
@theDBguy
Its not a runtime error. Its simply faulty in my case and returns nothing. Thanks
Understood. Please let us know if you find out something/anything. Cheers!
 
I don't remember if I ever tested my demo using UNC path, so just for fun, I gave it a try and this is what I got.

1631378929011.png
 
Hi,

Thanks for your reply @theDBguy

Your tool worked good for me when I tested your specific application. But converting the code to my project was unsuccessful.

Maybe its my implementation at the caller level. I like your design as it returns strings instead of a collection of objects. Strings are simple and nice.

Anyway, after reviewing these examples of Recursion, I just decided to write my own so I understand how its works. And it works flawlessly for me. I welcome you to test the code if you please.

Thanks for your help and others who contributed.

Code:
Sub Test()
Dim c       As New Collection
Dim fil     As file
Dim i       As Integer
Dim path As String

path = "\\Drive\Home\Desktop\Test"

Set c = ListDir(c, path, "jpg")

For i = 1 To c.count
    Set fil = c.Item(i)
    Debug.Print fil.path
Next i

End Sub


Function ListDir(ByRef Col As Collection, path As String, Optional FExt As String) As Collection
'@IronFelix717 - 9.11.21    access-programmers.co.uk
'LISTS ALL FILES IN A ROOT FOLDER AND ALL SUBFOLDERS, RECURSION METHOD
'COL = Target collection to store FSO.file objects
'OPTIONAL: PASS EXTENSION (EX:  ".JPG" or.. "JPG")
Dim FSO         As New FileSystemObject
Dim Fold        As Folder
Dim SubFold     As Folder
Dim fil         As file
Dim SubFolds    As New Collection
Dim i           As Integer
Dim tempc       As New Collection

If FSO.FolderExists(path) Then
    Set Fold = FSO.GetFolder(path)

    For Each fil In Fold.files
        If FExt <> "" Then
            'CLEAN UP
            If InStr(1, FExt, ".") > 0 Then
                FExt = Mid(FExt, 2, Len(FExt))
            End If
                
            If FSO.GetExtensionName(fil.name) = FExt Then
                Col.Add fil
            End If
        Else
            Col.Add fil
        End If
    Next fil
            
    For Each SubFold In Fold.SubFolders
        SubFolds.Add SubFold
    Next SubFold
    
    For i = 1 To SubFolds.count
        Set tempc = ListDir(Col, SubFolds.Item(i), FExt)
    Next i
    Set ListDir = Col
End If

End Function
 
Hi,

Thanks for your reply @theDBguy

Your tool worked good for me when I tested your specific application. But converting the code to my project was unsuccessful.

Maybe its my implementation at the caller level. I like your design as it returns strings instead of a collection of objects. Strings are simple and nice.

Anyway, after reviewing these examples of Recursion, I just decided to write my own so I understand how its works. And it works flawlessly for me. I welcome you to test the code if you please.

Thanks for your help and others who contributed.

Code:
Sub Test()
Dim c       As New Collection
Dim fil     As file
Dim i       As Integer
Dim path As String

path = "\\Drive\Home\Desktop\Test"

Set c = ListDir(c, path, "jpg")

For i = 1 To c.count
    Set fil = c.Item(i)
    Debug.Print fil.path
Next i

End Sub


Function ListDir(ByRef Col As Collection, path As String, Optional FExt As String) As Collection
'@IronFelix717 - 9.11.21    access-programmers.co.uk
'LISTS ALL FILES IN A ROOT FOLDER AND ALL SUBFOLDERS, RECURSION METHOD
'COL = Target collection to store FSO.file objects
'OPTIONAL: PASS EXTENSION (EX:  ".JPG" or.. "JPG")
Dim FSO         As New FileSystemObject
Dim Fold        As Folder
Dim SubFold     As Folder
Dim fil         As file
Dim SubFolds    As New Collection
Dim i           As Integer
Dim tempc       As New Collection

If FSO.FolderExists(path) Then
    Set Fold = FSO.GetFolder(path)

    For Each fil In Fold.files
        If FExt <> "" Then
            'CLEAN UP
            If InStr(1, FExt, ".") > 0 Then
                FExt = Mid(FExt, 2, Len(FExt))
            End If
               
            If FSO.GetExtensionName(fil.name) = FExt Then
                Col.Add fil
            End If
        Else
            Col.Add fil
        End If
    Next fil
           
    For Each SubFold In Fold.SubFolders
        SubFolds.Add SubFold
    Next SubFold
   
    For i = 1 To SubFolds.count
        Set tempc = ListDir(Col, SubFolds.Item(i), FExt)
    Next i
    Set ListDir = Col
End If

End Function
Hi. Glad to hear you got it sorted out. I gave your function a try, and it worked for me too. It found the same 126 files on my Desktop. Cheers!
 
All the examples i've seen go to 2 or 3 tiers down, but don't seem to be recursive to search at the very bottom level of a folder.

Other info: If necessary, we can assume practically that the maximum "nesting" is 4 tiers of subfolders below the root.

I can go down 10-15 folders deep with this. (eventually hits listbox limit)
I pass the top folder path and a valuelist listbox object with 3 columns.

Code:
Function PDListFiles(strFolder As String, lbx As ListBox)

    Dim fol As Folder
    Dim sfol As Folder
    Dim fil As File
    Dim fso As FileSystemObject

    Set fso = New FileSystemObject

    Set fol = fso.GetFolder(strFolder)

    For Each fil In fol.Files

        lbx.AddItem fol.Name & ";" & fil.Name & ";" & fil.Path

    Next

    For Each sfol In fol.SubFolders

        PDListFiles sfol.Path, lbx

    Next

End Function

here's the path to the deepest file in a test stack
Code:
C:\Users\pd\Desktop\NewComp\ClientFolders\Roger K\New folder\New folder\New folder\New folder\New folder\New folder\New folder\New folder\New folder\New folder (2)\New folder\New folder\New folder\New folder\New folder\Somefile.txt
 

Users who are viewing this thread

Back
Top Bottom