如何遍历子文件夹？

Question

我有 VBA 代码可以返回文件夹中文件的路径、类型、上次修改日期、上次创建日期等外部文件详细信息。

我想返回该文件夹子文件夹中文件的详细信息。

Dim IRow

Sub ListFiles()
    IRow = 11 'where you want your first row of data
    Call ListMyFiles(Range("B5"), False) 'Where B5 is your filepath (eg, C:\)
End Sub
    
Sub ListMyFiles(MySourcePath, includesubfolders)
    Dim xSubFolder As Object
    Set MyObject = New FileSystemObject
    Set mysource = MyObject.GetFolder(MySourcePath)
    On Error Resume Next
    For Each myfile In mysource.Files
        icol = 1
        Cells(IRow, icol).Value = myfile.Path
        icol = icol + 1
        Cells(IRow, icol).Value = myfile.Name
        icol = icol + 1
        Cells(IRow, icol).Value = myfile.Type
        icol = icol + 1
        Cells(IRow, icol).Value = myfile.DateLastModified
        icol = icol + 1
        Cells(IRow, icol).Value = myfile.DateCreated
        icol = icol + 1
           
        IRow = IRow + 1
    Next
    If xIsSubfolders Then
        For Each xSubFolder In xFolder.subfolders
            ListFilesInFolder xSubFolder.Path, True
        Next xSubFolder
    End If
    Set xFile = Nothing
    Set xFolder = Nothing
    Set xFileSystemObject = Nothing
End Sub

Answer 1

我没有对此进行测试，但基本上你想要的是递归。这是当您在该函数中调用子例程/函数时。基本上它是每次找到子文件夹时都会调用自己的子程序。

类似：

Dim IRow
Sub ListFiles() 
    IRow = 11 'where you want your first row of data    
    Call ListMyFiles(Range("B5"), False) 'Where B5 is your filepath (eg, C:\)
End Sub

Sub ListMyFiles(MySourcePath as string, includesubfolders as boolean)


    Set MyObject = New FileSystemObject
    Set mysource = MyObject.GetFolder(MySourcePath)

    On Error Resume Next
    For Each myfile In mysource.Files
        icol = 1
        Cells(IRow, icol).Value = myfile.Path
        icol = icol + 1
        Cells(IRow, icol).Value = myfile.Name
        icol = icol + 1
        Cells(IRow, icol).Value = myfile.Type
        icol = icol + 1
        Cells(IRow, icol).Value = myfile.DateLastModified
        icol = icol + 1
        Cells(IRow, icol).Value = myfile.DateCreated
        icol = icol + 1

        IRow = IRow + 1
    Next

    'Check if the subroutine was called to include subfolders
    If includesSubFolders Then
        'Loop through all of the subfolders in the FSO folder
        For Each SubFolder in mysource.SubFolders
            'Call this same subroutine
            ListMyFiles(Subfolder.Path, true)
        Next xSubFolder
    End If      


End Sub

Answer 2

这里可以简化很多事情。更重要的是，文件夹遍历需要递归调用才能遍历所有子文件夹级别。

这是一个执行此操作的示例代码。 ListMyFiles 的第一个参数是存储路径的单元格位置，第二个参数是您希望文件列表开始的位置。

Sub ListFiles()
    Call ListMyFiles(Sheet1.Range("B5"), Sheet1.Range("B11"), True)
End Sub

Sub ListMyFiles(ByVal r_SourcePath As Range, ByRef r_List As Range, Optional includesubfolders As Boolean = False)
    Dim path As String, ff As Folder
    path = r_SourcePath.Text
    Dim fso As New FileSystemObject
    Set ff = fso.GetFolder(path)
    Call ListFileInFolder(r_List, ff, includesubfolders)
End Sub

Public Sub ListFileInFolder(ByRef r_List As Range, ByRef ff As Folder, Optional inclSubFolders As Boolean = False)
    On Error Resume Next
    Dim index As Long, n As Long
    index = 0
    Dim f As File
    For Each f In ff.Files
        r_List.Offset(index, 0).Resize(1, 5).Value2 = _
            Array(f.path, f.Name, f.Type, f.DateLastModified, f.DateCreated)
        index = index + 1
    Next
    If inclSubFolders Then
        For Each ff In ff.SubFolders
            n = ff.Files.Count
            If n > 0 Then
                Call ListFileInFolder(r_List.Offset(index, 0), ff, True)
                index = index + n
            End If
        Next
    End If
    On Error GoTo 0
End Sub

这里需要注意的是使用单行和Array()函数写入单行5列数据。