script to write in an excel sheet the full content (recursively) of a dir choosen with msoFileDialogFolderPicker using FileSystemObject

Option Explicit

' version 20130511_133800

Dim objFileSystemObject
' ****************************************************************************************************
' collection with column names
' ****************************************************************************************************
Dim ColumnsColl As Collection
' ****************************************************************************************************
' worksheet to populate vars
' ****************************************************************************************************
Dim WorksheetToPopulate
Dim WorksheetToPopulate_RowCount



' script to write in an excel sheet the full content (recursively) of a dir choosen with msoFileDialogFolderPicker
Public Sub readfs()
' ****************************************************************************************************
' ****************************************************************************************************
' ****************************************************************************************************
' vars declaration
' ****************************************************************************************************
' ****************************************************************************************************
' ****************************************************************************************************
' filesystem
' ****************************************************************************************************
Dim FsPicker
Dim FsPicker_InitialFolder

' ****************************************************************************************************
' record start time
' ****************************************************************************************************
    Debug.Print Time


    
' ****************************************************************************************************
' set worksheet to populate + first row
' ****************************************************************************************************
    WorksheetToPopulate = "Foglio1"
    WorksheetToPopulate_RowCount = 1
    

' ****************************************************************************************************
' populate the collection with column names
' ****************************************************************************************************
    Set ColumnsColl = New Collection
    ColumnsColl.Add Item:=1, Key:="FileName"
    ColumnsColl.Add Item:=2, Key:="FileSize"
    ColumnsColl.Add Item:=3, Key:="FileLastMod"
    'debug.print ColumnsColl.Item(1)  ' <<< to acces the first element
    'debug.print ColumnsColl.Item("Filename")  ' <<< to acces the "Filename" element



' ****************************************************************************************************
' read a directory form the folder picker in   >>>   FsPicker.SelectedItems(1)
' ****************************************************************************************************

    FsPicker_InitialFolder = "C:\"   '<<< Startup folder to begin searching from
    
    Set FsPicker = Application.FileDialog(msoFileDialogFolderPicker)
    
    With FsPicker
        .InitialFileName = Application.DefaultFilePath & "\"
        .Title = "Please select a folder to list Files from"
        .InitialFileName = FsPicker_InitialFolder
        .Show
    End With
            
            
            
' ****************************************************************************************************
' read the directory recursively and put the content in the worksheet
' ****************************************************************************************************
    Set objFileSystemObject = CreateObject("Scripting.FileSystemObject")
            
    Application.ScreenUpdating = False
    On Error Resume Next
    
    If FsPicker.SelectedItems.Count = 0 Then
        mysubfolders ("c:\e2")
    Else
        mysubfolders (FsPicker.SelectedItems(1))
    End If
    
    On Error GoTo 0
    Application.ScreenUpdating = True
    
    
    
' ****************************************************************************************************
' end message + record start time
' ****************************************************************************************************
    MsgBox "end !!!"
    Debug.Print Time

    
    
End Sub



Private Sub mysubfolders(current_folder)
Dim objFolder, objSubFolder, objFile

    On Error Resume Next
    
    Set objFolder = objFileSystemObject.GetFolder(current_folder)
    
    For Each objFile In objFolder.Files
        'Debug.Print objFile.Name   ' <<< filename only
        'Debug.Print objFile.Path   ' <<< full path + filename
        mysubfolders_print objFile.Path, objFile.Size, objFile.DateLastModified
    Next
    
    For Each objSubFolder In objFolder.SubFolders
        mysubfolders (objSubFolder.Path)
    Next
    
End Sub



Private Sub mysubfolders_print(Current_Filename, Current_FileSize, Current_FileLastMod)
    WorksheetToPopulate_RowCount = WorksheetToPopulate_RowCount + 1
    
    Worksheets(WorksheetToPopulate).Cells(WorksheetToPopulate_RowCount, ColumnsColl.Item("Filename")) = Current_Filename
    Worksheets(WorksheetToPopulate).Cells(WorksheetToPopulate_RowCount, ColumnsColl.Item("FileSize")) = Current_FileSize
    Worksheets(WorksheetToPopulate).Cells(WorksheetToPopulate_RowCount, ColumnsColl.Item("FileLastMod")) = Current_FileLastMod
End Sub