Loop through a subfolders of a parent Folder and insert subfolder paths and and filenames

[iojbr]

Hi:

I am trying to adapt some code I found online for Excel into access vba that will enable me to loop through all subfolders of a parent folder, and then list the subfolder paths and file names in too separate columns of an access table. But so far, it will only insert the subfolder path and the file names (contained in the subfolder) for one of the subfolders (I am assuming the last subfolder counted). I have included the code below. Thanks for your help.

Private Sub Command0_Click()
Dim pth As String
Dim fso As FileSystemObject
Dim baseFolder As Folder
pth = "C:\Test Folder\" 'the base path which has to be searched for Files
Set fso = New FileSystemObject

''check if the folder actually exists or not

If (Not (fso.FolderExists(pth))) Then
'the folder path is invalid. Exiting.
MsgBox "Invalid Path"
Exit Sub
End If

Set baseFolder = fso.GetFolder(pth)

fileCounter = 1
PrintFileNames baseFolder
End Sub
Public Sub PrintFileNames(baseFolder As Folder)
Dim folder_ As Folder
Dim file_ As File
Dim Data1 As Database
Dim S1, S2 As String
Set Data1 = CurrentDb
DeleteTables "Files"
S1 = "Create Table [Files] (ID COUNTER CONSTRAINT PrimaryKey PRIMARY KEY,[String Group 1] text(255),[String Group 2] text(255))"
Data1.Execute S1
For Each folder_ In baseFolder.SubFolders
'call recursive function.
PrintFileNames folder_

Next folder_
For Each file_ In baseFolder.Files
'print files here
S2 = "INSERT INTO [Files] ([String Group 1],[String Group 2]) Values('" & baseFolder.Path & "','" & file_.Name & "')"
DoCmd.RunSQL S2
fileCounter = fileCounter + 1
Next file_
End Sub

 

[iojbr]

Hi guys:

I found the solution I was looking for. Thanks.