Access VBA search folders and Subfolders and append results to table

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

score 2 · Accepted Answer · edited May 23 '17 at 12:24

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.

Should mention that that class module should be named FileSearch. — tlemaster, Jan 10 '17 at 18:33
Can I pass the folder path from a DLookup e.g.: Dim fs As New FileSearch Dim ExtensionFilters As New Dictionary ExtensionFilters.Add "jpg", "jpg" ExtensionFilters.Add "jpeg", "jpeg" Set fs.ExtensionFilters = ExtensionFilters fs.listImages fs.listImages DLookup("ImageFolder", "qryMasterImageFolders") — Michael, Jan 11 '17 at 13:03
@Michael that is certainly possible. You might want to not call the dlookup right in the function call but instead on a separate line so you can check if the dlookup returns nothing. But they way you have it will work as well. — Brad, Jan 11 '17 at 16:18

Access VBA search folders and Subfolders and append results to table

1 Answers1