Omit Folders From Recursive File Search

问题

I was running a recursive file search procedure, and my computer shut down. I know what directory the procedure stopped at, is there a way I can specify a start folder for a recursive file search? For example, let's say this is my structure

R:\
R:\Test\
R:\Test\Folder1\
R:\Test1\
R:\Test1\Folder1\
R:\Test2\
R:\Test2\Folder2\

if I wanted the recursive search to start at

R:\Test1\Folder1\

how would the procedure go?

Option Compare Database

Sub ScanTablesWriteDataToText()
Dim Fileout As Object
Dim fso As Object
Dim objFSO As Object
Dim accapp As Access.Application
Dim db As DAO.Database
Dim tdf As DAO.TableDef
Dim colFiles As Collection
Set objFSO = CreateObject("Scripting.FileSystemObject")

Dim objRegExp As Object
Set objRegExp = CreateObject("VBScript.RegExp")
objRegExp.Pattern = ".jpg"
objRegExp.IgnoreCase = True

Set colFiles = New Collection

RecursiveFileSearch "R:\", objRegExp, colFiles, objFSO

For Each f In colFiles
    'do something
Next
Set objFSO = Nothing
Set objRegExp = Nothing

End Sub
Sub RecursiveFileSearch(ByVal targetFolder As String, ByRef objRegExp As Object, _
                ByRef matchedFiles As Collection, ByRef objFSO As Object)

Dim objFolder As Object
Dim objFile As Object
Dim objSubFolders As Object
Set objFolder = objFSO.GetFolder(targetFolder)
For Each objFile In objFolder.files
    If objRegExp.test(objFile) Then
        matchedFiles.Add (objFile)
    End If
Next
Set objSubFolders = objFolder.Subfolders
For Each objSubfolder In objSubFolders
    RecursiveFileSearch objSubfolder, objRegExp, matchedFiles, objFSO
Next
Set objFolder = Nothing
Set objFile = Nothing
Set objSubFolders = Nothing

End Sub

回答1:

I'd change your recursive sub to include two more parameters -- one for the folder you're trying to find, and a boolean to indicate whether or not it's been found:

Sub RecursiveFileSearch(ByVal targetFolder As String, ByRef objRegExp As Object, _
                ByRef matchedFiles As Collection, ByRef objFSO As Object, _
                ByVal startFolder As String, ByVal found As Boolean)

  Dim objFolder As Object
  Dim objFile As Object
  Dim objSubFolders As Object
  Set objFolder = objFSO.GetFolder(targetFolder)

  If startFolder = "" Or found Then
    For Each objFile In objFolder.files
      If objRegExp.test(objFile) Then
          matchedFiles.Add (objFile)
      End If
    Next
  End If

  Set objSubFolders = objFolder.Subfolders
  For Each objSubFolder In objSubFolders
    If objSubFolder = startFolder Then
      found = True
    End If

    RecursiveFileSearch objSubFolder, objRegExp, matchedFiles, objFSO, _
      startFolder, found
  Next

  Set objFolder = Nothing
  Set objFile = Nothing
  Set objSubFolders = Nothing

End Sub

When you call it, it would be:

RecursiveFileSearch "R:\", objRegExp, colFiles, objFSO, "R:\Test1\Folder1\", false

回答2:

You could short-cut this by running an (elegant) PowerShell

Dumps recursive JPG list to C:\temp\filename.csv

Sub Comesfast()
X2 = Shell("powershell.exe get-childitem ""C:\Test1\Folder1"" -recurse | where {$_.extension -eq "".jpg""} | Select-Object FullName| export-csv ""C:\temp\filename.csv"" ", 1)
End Sub

来源：https://stackoverflow.com/questions/40334712/omit-folders-from-recursive-file-search

标签

ms-access

recursion

vba

ms-access-2013