遍历所有子文件夹

Question

我试图遍历所有子文件夹。该脚本有效，但是仅提取某些文件夹，而不提取其他文件夹。我需要它来拉出文件夹中的所有文件。我没有创建完整的脚本，但想对其进行修改。

更新：

我在下面尝试了这种替代解决方案，并且有效。

Sub loopAllSubFolderSelectStartDirectory()

Dim FSOLibrary As Object
Dim FSOFolder As Object
Dim folderName As String

  'Set the folder name to a variable
  folderName = "C:\Users\dreid_000\Desktop\PhaseII\"

  'Set the reference to the FSO Library
  Set FSOLibrary = CreateObject("Scripting.FileSystemObject")

 'Another Macro must call LoopAllSubFolders Macro to start
  LoopAllSubFolders FSOLibrary.GetFolder(folderName)

  End Sub

---

Sub LoopAllSubFolders(FSOFolder As Object)

Dim FSOSubFolder As Object
Dim FSOFile As Object
Dim soldname As String
Dim sNewName As String
Dim sTempFile() As String
Dim sPath As String
Set Fso = CreateObject("Scripting.FileSystemObject")


   'For each subfolder call the macro
   For Each FSOSubFolder In FSOFolder.subfolders
   LoopAllSubFolders FSOSubFolder
   Next

   'For each file, print the name
   For Each FSOFile In FSOFolder.Files

'Insert the actions to be performed on each file
    FSOFile.Name = "PhaseII.xlsx"
'This example will print the full file path to the immediate window
    Debug.Print FSOFile.Path


Next

End Sub

Answer 1

这是一个很好的通用解决方案，基本上可以满足任何搜索文件夹及其子文件夹的要求。该函数可递归调用自身，并输出包含完整结果的字典对象，为清晰起见，代码注释如下：

Public Function SearchDirectory(ByVal arg_sFolderPath As String, _
                                Optional ByVal arg_sSearch As String = "*", _
                                Optional ByVal arg_bMatchCase As Boolean = False, _
                                Optional ByVal arg_bIncludeSubFolders As Boolean = True, _
                                Optional ByRef arg_hResults As Object) _
  As Object
'Purpose of this function is to search a directory (and probably all of its subfolders)
'for files that match an optionally provided search string, and the match may or may
'not be case sensitive. It then collects all of the results in a dictionary object and
'returns that dictionary object as the function output
'
'Parameters:
'  arg_sFolderPath:         [Required][String]              -The folder path of the original directory that will be searched
'
'  arg_sSearch:             [Optional][String]              -A pattern that will be matched against.
'                                                           -For example, to find all Excel files you would use "*.xls*"
'                                                           -Default value is "*" which will return all files
'
'  arg_bMatchCase:          [Optional][Boolean]             -Specifies whether or not to match arg_sSearch as case sensitive
'                                                           -For example, if this is set to True and the arg_sSearch is set to "*.xls*",
'                                                            then an Excel file named "EXCELFILE.XLSX" would NOT be found
'                                                           -Default value is False which will make matches not case sensitive
'
'  arg_bIncludeSubFolders   [Optional][Boolean]             -Specifies whether or not to search all subfolders recursively
'                                                           -Default value is True which will include results in all subfolders
'
'  arg_hResults             [Optional][Dictionary Object]   -An existing dictionary object to hold the results in
'                                                           -Typically this will not be provided on initial call, and is used
'                                                            during recursive calls to store all relevant results for output
'
'Author: tigeravatar on stackoverflow at https://stackoverflow.com/questions/56970854/loop-through-all-subfolders
'Created: July 10, 2019

    'Static so that during recursive search it doesn't need to be recreated on every recursive call
    Static oFSO As Object
    If oFSO Is Nothing Then Set oFSO = CreateObject("Scripting.FileSystemObject")

    'Check if arg_hResults was provided (typically not on first call, but will be on all subsequent recursive calls)
    'This preserves all found matching file results throughout all recursive calls of the function
    Dim hResults As Object
    If arg_hResults Is Nothing Then Set hResults = CreateObject("Scripting.Dictionary") Else Set hResults = arg_hResults

    'Variable used to store the folder path separator
    Dim sPS As String
    sPS = Application.PathSeparator

    'Adjust so that even if folder path isn't passed with an ending Path Separator, the function can handle it appropriately
    Dim sFolderPath As String
    If Right(arg_sFolderPath, Len(sPS)) = sPS Then sFolderPath = arg_sFolderPath Else sFolderPath = arg_sFolderPath & sPS

    'Verify the folder path provided is valid.  Allow for hidden folders to be searched as well
    If Len(Dir(sFolderPath, vbDirectory + vbHidden)) = 0 Then
        MsgBox "Invalid directory path provided: " & Chr(10) & arg_sFolderPath, , "Search Directory Error"
        Set SearchDirectory = Nothing
        Exit Function
    End If

    'Using the FileSystemObject, work with the provided and validated folder path
    Dim oFolder As Object
    Set oFolder = oFSO.GetFolder(sFolderPath)

    'Loop through all files in the folder
    Dim oFile As Object
    Dim bMatch As Boolean
    For Each oFile In oFolder.Files
        'Verify the file matches the provided search pattern (if any) according to case sensitivity
        bMatch = False
        If arg_bMatchCase = True Then
            If oFile.Name Like arg_sSearch Then bMatch = True
        Else
            If LCase(oFile.Name) Like LCase(arg_sSearch) Then bMatch = True
        End If

        'If match found, add it to the hResults dictionary
        If bMatch = True Then
            If Not hResults.Exists(oFile.Path) Then hResults.Add oFile.Path, oFile.Path
        End If
    Next oFile

    'If set to search subfolders (default behavior), have the function recursively call itself to search all subfolders
    If arg_bIncludeSubFolders = True Then
        Dim oSubFolder As Object
        For Each oSubFolder In oFolder.SubFolders
            Set hResults = SearchDirectory(oSubFolder.Path, arg_sSearch, arg_bMatchCase, arg_bIncludeSubFolders, hResults)
        Next oSubFolder
    End If

    'Set function output to the hResults dictionary if it contains any matched file results
    If hResults Is Nothing Then
        Set SearchDirectory = Nothing
    Else
        If hResults.Count = 0 Then Set SearchDirectory = Nothing Else Set SearchDirectory = hResults
    End If

End Function

这是如何使用该函数并使用其结果的示例：

Sub tgr()

    'Create an object variable and set it to the function SearchDirectory
    'Provide SearchDirectory arguments as desired
    Dim hFoundFiles As Object
    Set hFoundFiles = SearchDirectory("C:\Test")

    'Verify it actually found files matching your criteria in the folder specified
    If hFoundFiles Is Nothing Then Exit Sub  'Didn't return any results

    'Can output results to a worksheet
    ActiveWorkbook.ActiveSheet.Range("A1").Resize(hFoundFiles.Count).Value = Application.Transpose(hFoundFiles.Keys)

    'Can loop through each result if you need to do something with them individually
    Dim vFile As Variant
    For Each vFile In hFoundFiles.Keys
        'Do something here
        Debug.Print vFile
    Next vFile

End Sub