List the Files in a Folder and its Subfolders using the DIR Function

The following procedure uses the DIR function to list the files in a folder and its subfolders. The files will be listed in a worksheet in a newly created workbook.

'Force the explicit declaration of variables
Option Explicit

Sub ListFiles()

    'Declare the variables
    Dim sPath As String
    Dim aFiles() As String
    Dim lFileCnt As Long
    
    'Specify the path to the folder
    sPath = "C:\Users\Domenic\Documents"
    
    'Make sure the folder exists
    If Len(Dir(sPath, vbDirectory)) = 0 Then
        MsgBox "No such folder exists!", vbExclamation
        Exit Sub
    End If
    
    'Enable error handling
    On Error GoTo ErrHandler
    
    'Get the file names from the specified folder and its subfolders into an array
    Call RecursiveDirs(sPath, aFiles, lFileCnt)
    
    'Transfer the list of files from the array to a worksheet in a new workbook
    If lFileCnt > 0 Then
        Workbooks.Add xlWBATWorksheet
        Range("A1:C1").Value = Array("Filename", "Size (bytes)", "Created / Modified")
        Columns("B").NumberFormat = "#,##0"
        Columns("C").NumberFormat = "m/dd/yy h:mm AM/PM"
        Range("A2").Resize(UBound(aFiles, 2), UBound(aFiles, 1)).Value = Application.Transpose(aFiles)
        Columns("A:C").AutoFit
    Else
        MsgBox "No files found!", vbExclamation
    End If
    
ExitSub:
    Exit Sub
    
    'Error handling
ErrHandler:
    MsgBox "Error " & Err.Number & ":  " & Err.Description
    Resume ExitSub

End Sub

Sub RecursiveDirs(ByVal sCurrDir As String, ByRef aFiles() As String, ByRef lFileCnt As Long)

    'Declare the variables
    Dim sFileName As String
    Dim sPathAndName As String
    Dim aDirs() As String
    Dim lDirCnt As Long
    Dim i As Long
    
    'Make sure the path to the current folder ends with a backslash
    If Right(sCurrDir, 1) <> "\" Then
        sCurrDir = sCurrDir & "\"
    End If
    
    'Get the files
    sFileName = Dir(sCurrDir & "*.*", vbDirectory)
    While Len(sFileName) > 0
        If Left(sFileName, 1) <> "." Then
            sPathAndName = sCurrDir & sFileName
            If (GetAttr(sPathAndName) And vbDirectory) = vbDirectory Then
                'Store found folders in array
                lDirCnt = lDirCnt + 1
                ReDim Preserve aDirs(1 To lDirCnt)
                aDirs(lDirCnt) = sPathAndName
            Else
                'Store found files in array
                lFileCnt = lFileCnt + 1
                ReDim Preserve aFiles(1 To 3, 1 To lFileCnt)
                aFiles(1, lFileCnt) = sFileName
                aFiles(2, lFileCnt) = FileLen(sPathAndName)
                aFiles(3, lFileCnt) = FileDateTime(sPathAndName)
            End If
        End If
        sFileName = Dir
    Wend
    
    'Process the found folders, recursively
    For i = 1 To lDirCnt
        Call RecursiveDirs(aDirs(i), aFiles, lFileCnt)
    Next i
    
End Sub

Where to Put the Code

  1. Open the workbook in which to store the code.
  2. Open the Visual Basic Editor (Alt+F11).
  3. Insert a standard module (Insert > Module).
  4. Copy/paste the above code into the module.
  5. Return to Microsoft Excel (Alt+Q).
  6. Save the workbook.

How to Use the Macro

  1. Display the Macro dialog box (Alt+F8).
  2. Click/select the macro called "ListFiles".
  3. Click/select "Run".

Sample Workbook: Download

Home | Excel | VBA | Blog | About | Contact