Прокрутите все вложенные папки и файлы в папке и напишите последнюю измененную информацию о дате в электронную таблицу Excel

Question

Я искал форум и нашел похожие вопросы, на которые был дан ответ, но я действительно новичок в VBA.

Я хочу скопировать имя, путь и последние измененные данные даты в электронную таблицу Excel.

Код в следующих двух потоках может помочь мне добавить имя, путь и последние измененные данные даты определенной папки в таблицу. Единственное, что мне нужно сделать, это добавить цикл, который ищет файлы в подпапках. Я попытался, но это не удалось.

Может ли кто-нибудь помочь мне добавить петлю файлов в подпапках на основе кода ниже?

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 

Answer 2

Ok попробовать это, чтобы получить файлы на папки и подпапки:

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.
Чтобы проверить, есть все еще вложенные папки undet, вы можете использовать:

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

Не совсем идеальный, но должен работать. НТН.