File List Code - how to include subfolder contents

[Upex]

Hi All,

Been using this, but need for it to include contents within subfolders, and can't figure out how to do it.

Any one suggest the way / provide a steer?

Also, is it possible to add a column with details of the last user to save it, or access it? - not sure if that data is held with the file or not.

Thanks,

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


Sub ListMyFiles(MySourcePath, includesubfolders)
    Set MyObject = CreateObject("Scripting.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.Size
        icol = icol + 1
        Cells(IRow, icol).Value = myfile.DateLastModified
        icol = icol + 1
        Cells(IRow, icol).Value = myfile.Datelastaccessed
        icol = icol + 1
        Cells(IRow, icol).Value = myfile.Datecreated
        icol = icol + 1
        
        IRow = IRow + 1
    Next
    
End Sub

Upex

 

[Yongle]

Try this and modify to suit
Post all code into the same module and Run GetFolder
Navigate to a folder, select and click "OK"
Content of folder and its children are listed in the active sheet


Code modified slightly but credit to this website http://buffalobi.com/excel/excel-vba-list-files-folders-subfolders/

Sub GetFolder()

Range("A:L").ClearContents
Range("A1:L1").Value = Split("Name,Path,Size (KB),DateLastModified,Attributes,DateCreated,DateLastAccessed,Drive,ParentFolder,ShortName,ShortPath,Type", ",")
Range("A2").Select

Dim strPath As String, fldr

Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
If fldr.Show <> -1 Then Exit Sub
strPath = fldr.SelectedItems(1)

Dim OBJ As Object, Folder As Object, File As Object
Set OBJ = CreateObject("Scripting.FileSystemObject")
Set Folder = OBJ.GetFolder(strPath)

Call ListFiles(Folder)

Dim SubFolder As Object

For Each SubFolder In Folder.Subfolders
    Call ListFiles(SubFolder)
    Call GetSubFolders(SubFolder)
Next SubFolder

Range("A1").Select

End Sub

Sub ListFiles(ByRef Folder As Object)

For Each File In Folder.Files
        With ActiveCell
        .Offset(1, 0).Select
        .Value = File.Name
        .Offset(0, 1) = File.Path
        .Offset(0, 2) = (File.Size / 1024) 'IN KB
        .Offset(0, 3) = File.DateLastModified
        .Offset(0, 4) = File.Attributes
        .Offset(0, 5) = File.DateCreated
        .Offset(0, 6) = File.DateLastAccessed
        .Offset(0, 7) = File.Drive
        .Offset(0, 8) = File.ParentFolder
        .Offset(0, 9) = File.ShortName
        .Offset(0, 10) = File.ShortPath
        .Offset(0, 11) = File.Type
        End With
Next File

End Sub

Sub GetSubFolders(ByRef SubFolder As Object)

Dim FolderItem As Object

For Each FolderItem In SubFolder.Subfolders
    Call ListFiles(FolderItem)
    Call GetSubFolders(FolderItem)
Next FolderItem

End Sub

 

[Upex]

Works lovely, many thanks Yongle.