Question

我正在使用Access 2013并有一个小程序来查找传递给它的文件夹路径中的所有图像。然后，它将每个路径附加到名为＆＃34; tblImages＆＃34;的表中。唯一的问题是它只返回每个文件夹\子文件夹中的第一个图像，即每个文件夹中的1个图像，并忽略其余部分。如何修改它以搜索并附加每个文件夹\子文件夹中的每个图像？

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

的类模块中

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搜索文件夹和子文件夹，并将结果附加到表

1 个答案: