Question

我搜索了论坛，发现了类似的问题得到了解答，但我真的是VBA的初学者。

我想将名称，路径和上次修改日期信息复制到Excel电子表格中。

以下两个主题中的代码可以帮助我将某个文件夹的名称，路径和上次修改日期信息添加到Spreadsheet。我唯一需要做的就是添加一个循环来搜索子文件夹下的文件。我试过，但没有成功。

任何人都可以帮我根据下面的代码添加子文件夹中的文件循环吗？

Getting file last modified date (explorer value not cmd value)

Excel VBA using FileSystemObject to list file last date modified

Sub ListFilesinFolderNew()

    Dim FSO As Scripting.FileSystemObject
    Dim SourceFolder As Scripting.Folder
    Dim FileItem As Scripting.File
    Dim fsoFol As Scripting.Folder

    SourceFolderName = "C:\Users\lc\Downloads"

    Set FSO = New Scripting.FileSystemObject
    Set SourceFolder = FSO.GetFolder(SourceFolderName)

    Range("A1:C1") = Array("file", "path", "Date Last Modified")

    i = 2

    For Each fsoFol In SourceFolder.SubFolders

    For Each FileItem In fsoFol.Files
        Cells(i, 1) = FileItem.Name
        Cells(i, 2) = FileItem
        Cells(i, 3) = FileItem.DateLastModified
        i = i + 1
    Next FileItem

    Next fsoFol

    Set FSO = Nothing

End Sub

谢谢。

Answer 1

为了列出文件夹及其子文件夹中的所有文件，我建议将列表逻辑分成单独的Sub并以递归方式调用它。

像这样的东西

Sub ListFilesinFolderNew()
    Dim FSO As Scripting.FileSystemObject
    Dim ws As Worksheet
    Dim cl As Range
    Dim SourceFolderName As String

    SourceFolderName = "C:\Users\lc\Downloads"

    Set FSO = New Scripting.FileSystemObject

    Set ws = ActiveSheet  '<-- adjust to suit your needs

    ws.Range("A1:C1") = Array("file", "path", "Date Last Modified")
    Set cl = ws.Cells(2, 1)

    ListFolders cl, FSO.GetFolder(SourceFolderName)

    Set FSO = Nothing
End Sub

Sub ListFolders(rng As Range, Fol As Scripting.Folder)
    Dim SubFol  As Scripting.Folder
    Dim FileItem As Scripting.File

    ' List Files
    For Each FileItem In Fol.Files
        rng.Cells(1, 1) = FileItem.Name
        rng.Cells(1, 2) = FileItem.ParentFolder.Path
        rng.Cells(1, 3) = FileItem.DateLastModified
        Set rng = rng.Offset(1, 0)
    Next

    ' Proces subfolders
    For Each SubFol In Fol.SubFolders
        ListFolders rng, SubFol
    Next
End Sub

使用Dir的替代方法

Sub ListFilesinFolderNew2()
    Dim Path As String
    Dim fl As String
    Dim ws As Worksheet
    Dim cl As Range

    Set ws = ActiveSheet

    Path = "C:\Users\lc\Downloads"
    ws.Range("A1:C1") = Array("file", "path", "Date Last Modified")
    Set cl = ws.Cells(2, 1)

    ListFolder cl, Path, "*.*"
End Sub


Sub ListFolder(rng As Range, Path As String, Patt As String)
    Dim fl As String
    Dim sf As Collection
    Dim v As Variant

    If Right$(Path, 1) <> "\" Then Path = Path & "\"
    fl = Dir(Path & Patt)
    Do While fl <> vbNullString
        rng.Cells(1, 1) = fl
        rng.Cells(1, 2) = Path
        rng.Cells(1, 3) = FileDateTime(Path & fl)
        Set rng = rng.Offset(1, 0)

        fl = Dir()
    Loop
    Set sf = New Collection
    fl = Dir(Path, vbDirectory)
    Do While fl <> vbNullString
        If fl <> "." And fl <> ".." Then
            If (GetAttr(Path & fl) And vbDirectory) <> 0 Then
                sf.Add Path & fl
            End If
        End If
        fl = Dir()
    Loop
    For Each v In sf
        rng.Cells(1, 2) = Path
        Set rng = rng.Offset(1, 0)
        ListFolder rng, CStr(v), Patt
    Next
End Sub

Answer 2

好的尝试这个来获取文件夹和子文件夹上的文件：

Dim donewithparent As Boolean
For Each fsoFol In SourceFolder.SubFolders
    If Not donewithparent Then
        For Each FileItem In fsoFol.ParentFolder.Files
            Cells(i, 1) = FileItem.Name
            Cells(i, 2) = FileItem
            Cells(i, 3) = FileItem.DateLastModified
            i = i + 1
        Next
    End If
    donewithparent = True        
    For Each FileItem In fsoFOL.Files
        Cells(i, 1) = FileItem.Name
        Cells(i, 2) = FileItem
        Cells(i, 3) = FileItem.DateLastModified
        i = i + 1
    Next FileItem
Next fsoFol

或者你可以在循环子文件夹之前为它做一个单独的循环。
只需使用 ParentFolder 等可用属性即可。
要检查是否还有子文件夹，请使用：

If fsoFol.Subfolders.Count > 0 Then
    '~~> add another loop here
End If

不太理想，但应该有效。 HTH。

遍历文件夹下的所有子文件夹和文件，并将最后修改的日期信息写入Excel电子表格

2 个答案: