Access VBA search folders and Subfolders and append results to table - ms-access

Question

I'm using Access 2013 and have a small program to lookup all images in a folder path that is passed to it. It then appends each of these paths to a table called "tblImages". The only problem is it only ever returns the first image in each folder\sub folder i.e. 1 image from each folder and ignores the rest. How do I modify it to search for and append every single image in each folder\sub folder?
Public Sub listImages(folderPath As String)
'define variables
Dim fso As Object
Dim objFolder As Object
Dim objFolders As Object
Dim objF As Object
Dim objFile As Object
Dim objFiles As Object
Dim strFileName As String
Dim strFilePath As String
Dim myList As String
Dim rst As DAO.Recordset
'set file system object
Set fso = CreateObject("Scripting.FileSystemObject")
'set folder object
Set objFolder = fso.GetFolder(folderPath)
'set files
Set objFiles = objFolder.files
Set objFolders = objFolder.subfolders
'list all images in folder
For Each objFile In objFiles
If Right(objFile.Name, 4) = ".jpg" Then
strFileName = objFile.Name
strFilePath = objFile.path
myList = myList & strFileName & " - " & strFilePath & vbNewLine
End If
Next
'go through all subflders
For Each objF In objFolders
'call same procedure for each subfolder
Call listImages(objF.path)
Next
Set rst = CurrentDb.OpenRecordset("tblImages", dbOpenDynaset, dbSeeChanges)
With rst
.AddNew
.Fields("Image") = strFileName
.Fields("FilePath") = strFilePath
.Update
End With
'Debug.Print myList
Set objFolder = Nothing
Set objFolders = Nothing
Set objFile = Nothing
Set objF = Nothing
Set fso = Nothing
End Sub

Answer 1

You were very close. You can put this in a class module named FileSearch
Option Compare Database
Option Explicit
Private fso As FileSystemObject
Public ExtensionFilters As Dictionary
Private Sub Class_Initialize()
Set fso = New FileSystemObject
End Sub
Public Sub listImages(folderPath As String)
'define variables
Dim objFolder As Folder
Dim objFolders As Folders
Dim objF As Folder
Dim objFile As File
Dim objFiles As Files
Dim strFileName As String
Dim strFilePath As String
Dim myList As String
Dim rst As DAO.Recordset
If Not fso.FolderExists(folderPath) Then Exit Sub
'set folder object
Set objFolder = fso.GetFolder(folderPath)
'set files
Set objFiles = objFolder.Files
Set objFolders = objFolder.SubFolders
'list all images in folder
For Each objFile In objFiles
If Not ExtensionFilters Is Nothing Then
If ExtensionFilters.Exists(fso.GetExtensionName(objFile.path)) Then
strFileName = objFile.Name
strFilePath = objFile.path
AddImageToTable strFileName, strFilePath
End If
End If
Next
'go through all subflders
For Each objF In objFolders
'call same procedure for each subfolder
Call listImages(objF.path)
Next
End Sub
Private Sub AddImageToTable(strFileName, strFilePath)
Debug.Print strFileName, strFilePath
' change as needed
' Set rst = CurrentDb.OpenRecordset("tblImages", dbOpenDynaset, dbSeeChanges)
' With rst
' .AddNew
' .Fields("Image") = strFileName
' .Fields("FilePath") = strFilePath
' .Update
' End With
End Sub
and call it like this from wherever
Dim fs As New FileSearch
Dim ExtensionFilters As New Dictionary
ExtensionFilters.Add "jpg", "jpg"
ExtensionFilters.Add "jpeg", "jpeg"
Set fs.ExtensionFilters = ExtensionFilters
fs.listImages "C:\Users\bradley_handziuk\Downloads"
Also relevant is the DIR function.