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列的一行数据。

必须修改下面的宏代码，以告知文件夹中的文件和特定文件夹中的子文件夹的文件详细信息

2 个答案: