访问 VBA 搜索文件夹和子文件夹并将结果附加到 table

Question

我正在使用 Access 2013 并有一个小程序可以查找传递给它的文件夹路径中的所有图像。然后它将这些路径中的每一个附加到名为 "tblImages" 的 table 中。唯一的问题是它只 returns 每个 folder\sub 文件夹中的第一张图像，即每个文件夹中的一张图像，而忽略其余图像。我如何修改它以在每个 folder\sub 文件夹中搜索并附加每个图像？

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

你们非常亲密。您可以将其放入名为 FileSearch

的 class 模块中

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

然后在任何地方都这样称呼它

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"

同样相关的是 DIR function。

访问 VBA 搜索文件夹和子文件夹并将结果附加到 table

Access VBA search folders and Subfolders and append results to table

ms-access

vba

ms-access-2013