Text Functions‎ > ‎

List Files in Folder and Subfolders

The main point of this page is to demonstrate how a macro that processes all the files in a single folder can be adapted into a set of 3 macros that will perform the same task on every file in a folder and in all the subfolders inside that starting folder.  The resulting macros will delve down now matter how many subfolders within subfolders there are, it will go through them all.


ORIGINAL SPECIFICATION:
  1. Create a list of all files in a single folder on sheet1
  2. Output sheet is refreshed each time the macro is run

CODE:

Sub ListFilesinSingleFolder()
'Jerry Beaucaire - 8/1/2009 - make a list of all files in a single folder
Dim fso As Object, f As Object, Fld As Object, NR As Long, MyPath As String

MyPath = "C:TEMP"                                   'path to folder to list files
Application.ScreenUpdating = False                  'speed macro

Sheets("Sheet1").Range("A1:C150").ClearContents     'clear prior list, setup new titles
Sheets("Sheet1").Range("A1:C1").Value = Array("File Name", "Created", "Last Modified")

NR = 2                                              'next empty row to add data
Set fso = CreateObject("Scripting.FileSystemObject")
Set Fld = fso.Getfolder(MyPath).Files

For Each f In Fld                                   'locate one file at a time in given path, list the info
    Sheets("Sheet1").Range("A" & NR).Value = f.Name
    Sheets("Sheet1").Range("B" & NR).Value = f.DateCreated
    On Error Resume Next
    Sheets("Sheet1").Range("C" & NR).Value = f.DateLastModified
    On Error GoTo 0
    NR = NR + 1                                     'increment to next empty row
Next f

Sheets("Sheet1").Columns.AutoFit                    'cleanup the output
Application.ScreenUpdating = True                   'update screen one time, back to normal

End Sub



NEW SPECIFICATION:
  1. Create a list of all files in a folder and all of its subfolders on sheet1
  2. Output sheet is refreshed each time the macro is run

This new approach will have 3 macros to accomplish this "delving" effect.

  • ListStarter - this macro initiates the process and calls the LoopController feeding in the initial starting folder

  • LoopController - this macro calls the "main" macro feeding in the current path to that macro.  Then it checks for the existence of any subfolders in the current folder just processed.  If any are found, the LoopController will call itself again feeding in the new subfolder as the new target folder.  This macro thus can create an infinite number of loops within loops, each calling a new folder until all folders in folders have been found and looped into the main macro.

  • ListFilesinAllFolders - this is the "main" macro.  It accepts an incoming path parameter and then does it's "thing" on all the files in that folder, just like the original macro did above.  When it's finished, it releases focus back to the LoopController.

CODE

Sub ListStarter()
'Jerry Beaucaire - 6/11/2013 - make a list of all files in a single folder
'This macro sets up the output sheet, then starts the loop feeding in starting folder

Application.ScreenUpdating = False                      'speed macro
Sheets("Sheet1").Range("A1:C150").ClearContents         'clear output sheet and reset titles
Sheets("Sheet1").Range("A1:C1").Value = Array("File Name", "Created", "Last Modified")

LoopController ("C:\TEMP")                              'start the loop with the initial top folder

Sheets("Sheet1").Columns.AutoFit                        'we're done, cleanup the final output
Application.ScreenUpdating = True                       'update screen one time, back to normal

End Sub

Private Sub LoopController(sSourceFolder As String)
'This will loop into itself, first processing the files in the folder
'then looping into each subfolder deeper and deeper until all folders processed
Dim Fldr As Object, SubFldr As Object

    Call ListFilesinAllFolders(sSourceFolder & Application.PathSeparator)   'call the main macro with the current folder

                                                        'now check for existence of subfolders in current folder
    Set Fldr = CreateObject("Scripting.FileSystemObject").Getfolder(sSourceFolder)
    For Each SubFldr In Fldr.SubFolders                 'start the loop again for each subfolder in current folder
        LoopController SubFldr.Path
    Next

End Sub

Sub ListFilesinAllFolders(MyPath As String)
Dim fso As Object, f As Object, Fld As Object, NR As Long

NR = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row     'find last used row of data
Set fso = CreateObject("Scripting.FileSystemObject")
Set Fld = fso.Getfolder(MyPath).Files

For Each f In Fld                                       'process each file found in the folder
    NR = NR + 1                                         'increment to the next empty row
    Sheets("Sheet1").Range("A" & NR).Value = f.Name     'add info to output
    Sheets("Sheet1").Range("B" & NR).Value = f.DateCreated
    On Error Resume Next
    Sheets("Sheet1").Range("C" & NR).Value = f.DateLastModified
    On Error GoTo 0
Next f

End Sub






Nothing says "thanks" like a steak dinner!
PayPal - The safer, easier way to pay online!
Comments