Excel VBA and Macro Examples
Home » learn » Excel VBA and Macro Examples » Excel Macro: List All Files in Folders and Subfolders

Excel Macro: List All Files in Folders and Subfolders

7 minutes to read
5077 44

This Excel macro can list files (include hidden files) in a specified folder and subfolders, or files with a specific extension.

Updated November 8, 2022: This code has been rewritten to meet most needs.

If you want to get more file informations, such as video length, see this macro: Excel Macro: List Files in Subfolders, Version 2

List All Files in Folders and Subfolders

Option Explicit
'----------- ExcelBaby.com -----------
'-------------- Modules --------------
Sub ListFile()
    ''Description: List all files in folder and sub-folders (include hidden ,read only...)
    ''Web Site: https://excelbaby.com
    ''Url: https://excelbaby.com/learn/excel-macro-list-all-files-in-folders-and-subfolders/

    Dim PathSpec As String
    PathSpec = ""   'Specify a folder
    If (PathSpec = "") Then PathSpec = SelectSingleFolder   'Browse for Folder to select a folder

    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")    'Late Binding
    If (fso.FolderExists(PathSpec) = False) Then Exit Sub   'folder exist or not?

    Application.ScreenUpdating = False 'Disable Screen Updating to speed up macro
    
    Dim MySheetName As String
    MySheetName = "Files"   'Add a Sheet with name "Files"
    AddSheet (MySheetName)

    Dim FileType As String
    FileType = "*"   '*:all, or pdf, PDF, XLSX...
    FileType = UCase(FileType)

    Dim queue As Collection, oFolder As Object, oSubfolder As Object, oFile As Object
    Dim LastBlankCell As Long, FileExtension As String

    Set queue = New Collection
    queue.Add fso.GetFolder(PathSpec) 'enqueue
    
    Do While queue.Count > 0
        Set oFolder = queue(1)
        queue.Remove 1 'dequeue
        
        For Each oSubfolder In oFolder.SubFolders   'loop all sub-folders
            queue.Add oSubfolder 'enqueue
            '...insert any folder processing code here...
        Next oSubfolder
        
        LastBlankCell = ThisWorkbook.Sheets(MySheetName).Cells(Rows.Count, 1).End(xlUp).Row + 1 'get the last blank cell of column A
        
        For Each oFile In oFolder.Files 'loop all files
            FileExtension = UCase(Split(oFile.Name, ".")(UBound(Split(oFile.Name, ".")))) 'get file extension, eg: TXT
            If (FileType = "*" Or FileExtension = FileType) Then
                With ThisWorkbook.Sheets(MySheetName)
                    .Cells(LastBlankCell, 1) = oFile 'Path
                    .Cells(LastBlankCell, 2) = oFolder 'Folder
                    .Cells(LastBlankCell, 3) = oFile.Name 'File Name
                    .Cells(LastBlankCell, 4) = FileExtension 'File Extension
                    .Cells(LastBlankCell, 5) = oFile.DateCreated 'Data Created
                    .Cells(LastBlankCell, 6) = oFile.DateLastAccessed 'Last Accessed
                    .Cells(LastBlankCell, 7) = oFile.DateLastModified 'Last Modified
                    .Cells(LastBlankCell, 8) = oFile.Size 'File Size
                    If (oFile.Attributes And 2) = 2 Then
                        .Cells(LastBlankCell, 9) = "TRUE" 'Is Hidden
                    Else
                        .Cells(LastBlankCell, 9) = "FALSE" 'Is Hidden
                    End If
                End With
                LastBlankCell = LastBlankCell + 1
            End If
        Next oFile
    Loop
    
    'Cells.EntireColumn.AutoFit  'Autofit columns width
    Application.ScreenUpdating = True

End Sub

Function SelectSingleFolder()
    'Select a Folder Path
    
    Dim FolderPicker As FileDialog
    Dim myFolder As String
    
    'Select Folder with Dialog Box
    Set FolderPicker = Application.FileDialog(msoFileDialogFolderPicker)
    
    With FolderPicker
        .Title = "Select A Single Folder"
        .AllowMultiSelect = False
        If .Show <> -1 Then Exit Function 'Check if user clicked cancel button
        SelectSingleFolder = .SelectedItems(1)
    End With
End Function

Function AddSheet(MySheetName As String)
    'Add a worksheet with custom name
    
    Dim Mysheet As Worksheet, F As Boolean
    For Each Mysheet In ThisWorkbook.Worksheets
        If Mysheet.Name = MySheetName Then
            Sheets(MySheetName).Cells.Delete
            F = True
            Exit For
        Else
            F = False
        End If
    Next
    If Not F Then Sheets.Add.Name = MySheetName
    
    'Add table header
    With Sheets(MySheetName)
        .Cells(1, 1) = "Path"
        .Cells(1, 2) = "Folder"
        .Cells(1, 3) = "File Name"
        .Cells(1, 4) = "File Extension"
        .Cells(1, 5) = "Data Created"
        .Cells(1, 6) = "Last Accessed"
        .Cells(1, 7) = "Last Modified"
        .Cells(1, 8) = "Size"
        .Cells(1, 9) = "Is Hidden"
    End With
End Function

How to use this macro

We define several important variables you need to know:

  • PathSpec: line 10, specify a folder, if omitted, we will open Browse for Folder to select a folder, default: browse for folder.
  • MySheetName: line 20, specifies the name of the worksheet to list file information, default sheet name: Files.
  • FileType: line 24, specify the file types to list, default all types, case insensitive. E.g. *, PDF, txt....

Examples

List all files in folder "D:\MyWorkBooks", line 10:

PathSpec = "D:\MyWorkBooks"

Specifies the worksheet name with "PDF", line 20:

MySheetName = "PDF"

Specify the sheet name using the folder name, , line 20:

MySheetName = fso.GetFolder(PathSpec).Name

Only list "PDF" file, line 24:

FileType = "PDF"

Folders property

If you want to set folders property (hidden or unhidden folders), insert any folder processing code in line 39.

Set folders attribute to Unhidden

            If (oSubfolder.Attributes And 2) = 2 Then
                oSubfolder.Attributes = oSubfolder.Attributes - 2
            End If

Set folders attribute to Hidden

            If (oSubfolder.Attributes And 2) <> 2 Then
                oSubfolder.Attributes = oSubfolder.Attributes + 2
            End If

File Property

Determine if the file attribute is Not Hidden

If (oFile.Attributes And 2) <> 2 Then 'The file attribute is Not hidden

Determine if the file attribute is Read only

If (oFile.Attributes And 1) = 1 Then 'The file attribute is Read only

Download

Download this macro and examples.

Learn more

Most VBA code should be placed in Standard Modules unless specified.

If you see a comment '------------------ Modules------------------ in the code header that means put the code in a Standard Module. For more information, learn this course: Where should I put the Excel VBA code?

The following steps teach you how to put VBA code into a Standard Module:

  1. Activate the Visual Basic Editor by pressing ALT + F11.
  2. Right-click the project/workbook name in the Project Window.
  3. Choose Insert -> Module.
  4. Type or paste the code in the newly created module. You will probably need to change the sheet name, the range address, and the save location.
  5. Click Run button on the Visual Basic Editor toolbar.
  6. For more information, learn this course: Programming with Excel VBA
❮ PreviousNext ❯

Leave a comment

Your email address will not be published. Required fields are marked *

Format your code: <pre><code class="language-vba">place your code here</code></pre>

44 comments
  1. AM
    Amberle

    Awesome! By inserting one column for new filename, is there a way to apply with this List All Files in Folders and Subfolders to rename all files from list (folders & subfolders) at once base on the new filename column?

  2. PO
    PON

    It is great. May I know how to show the results to userform combobox? Thanks.

  3. IN
    Inês

    Hi thank you this helped a lot! Is there a way to list only the 20 most recent files in all the folder and subfolders to avoid over charging the excel?

    • EX
      ExcelBaby (Author)

      @Inês You can add a counter and exit the loop when the counter reaches 20, replace line 44-64 with below codes: 

              Dim icount As Integer
        icount = 0
        For Each oFile In oFolder.Files 'loop all files
            FileExtension = UCase(Split(oFile.Name, ".")(UBound(Split(oFile.Name, ".")))) 'get file extension, eg: TXT
            If (FileType = "*" Or FileExtension = FileType) Then
                With ThisWorkbook.Sheets(MySheetName)
                    .Cells(LastBlankCell, 1) = oFile 'Path
                    .Cells(LastBlankCell, 2) = oFolder 'Folder
                    .Cells(LastBlankCell, 3) = oFile.Name 'File Name
                    .Cells(LastBlankCell, 4) = FileExtension 'File Extension
                    .Cells(LastBlankCell, 5) = oFile.DateCreated 'Data Created
                    .Cells(LastBlankCell, 6) = oFile.DateLastAccessed 'Last Accessed
                    .Cells(LastBlankCell, 7) = oFile.DateLastModified 'Last Modified
                    .Cells(LastBlankCell, 8) = oFile.Size 'File Size
                    If (oFile.Attributes And 2) = 2 Then
                        .Cells(LastBlankCell, 9) = "TRUE" 'Is Hidden
                    Else
                        .Cells(LastBlankCell, 9) = "FALSE" 'Is Hidden
                    End If
                End With
                LastBlankCell = LastBlankCell + 1
            End If
            icount = icount + 1
            If (icount = 20) Then
                Exit For
            End If
        Next oFile
    • EX
      ExcelBaby (Author)

      @Inês Sorry, the previous code is not sorting the files by last modified date, please use the correct code below. For more information, please read:
      Excel Macro: List Files From Directory Order By Date Modified.

      Sub GetFilesInFolder(FolderPath As String, GetSubfolders As Boolean)
' For Example: GetFilesInFolder("D:\YourFolderName", True)
' Url: https://excelbaby.com/learn/excel-macro-list-files-in-subfolders-version-2/

    Dim FSO As Object, objFolder As Object
    Dim SubFolder, FileItem
    Dim LastBlankCell As Long
      
    Dim arr
    Dim i
    Dim FileExtension
    Dim icount
    
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set objFolder = FSO.GetFolder(FolderPath)
    
    Application.ScreenUpdating = False 'Disable Screen Updating to speed up macro
    
    LastBlankCell = Cells(Rows.Count, 1).End(xlUp).Row + 1 'Get the last blank cell of column A
    
    ' Table header
    If LastBlankCell = 2 Then
        Range("A1:J1").Value = Array("#", "Name", "Attributes", "Path", "Size", _
            "Type", "Extension", "Date Created", "Date Last Accessed", "Date Last Modified")
    End If
    
    ' sort by Date Last Modified
    arr = Split(CreateObject("wscript.shell").exec("cmd /c Dir " & FolderPath & " /A:-D /B /O:-D /T:W").stdout.readall, vbCrLf)

    icount = 1

    For i = 1 To UBound(arr) 'loop all files
        ' get file extension
        FileExtension = UCase(Split(arr(i - 1), ".")(UBound(Split(arr(i - 1), "."))))
                        
        Select Case FileExtension
            Case "XLS", "XLSX", "XLSM"    'Get "XLS", "XLSX", "XLSM" files
                With FSO.getfile(FolderPath & "\" & arr(i - 1))
                    Cells(LastBlankCell, 1) = LastBlankCell - 1         '#
                    Cells(LastBlankCell, 2) = arr(i - 1)                'Name
                    Cells(LastBlankCell, 3) = .Attributes               'Attributes
                    Cells(LastBlankCell, 4) = FolderPath                'Path
                    Cells(LastBlankCell, 5) = .Size                     'Size
                    Cells(LastBlankCell, 6) = .Type                     'Type
                    Cells(LastBlankCell, 7) = FileExtension             'Extension
                    Cells(LastBlankCell, 8) = .DateCreated              'Date Created
                    Cells(LastBlankCell, 9) = .DateLastAccessed         'Date Last Accessed
                    Cells(LastBlankCell, 10) = .DateLastModified        'Date Last Modified
                End With
                icount = icount + 1
                LastBlankCell = LastBlankCell + 1   'next row number
                ' only list 2 files
                If icount > UBound(arr) Or icount > 20 Then Exit For
            Case Else
                                    
        End Select
        
    Next

    ' Get the Files of Subfolders. This is a Nested-Function Calling.
    If GetSubfolders = True Then
        For Each SubFolder In objFolder.Subfolders
            GetFilesInFolder SubFolder.Path, True
        Next SubFolder
    End If

    Set objFolder = Nothing
    Set FSO = Nothing
    Cells.EntireColumn.AutoFit
    Application.ScreenUpdating = True
End Sub

Sub RunThisMacroToTest()
    ' change "D:\YourFolder" with yours
    GetFilesInFolder "D:\YourFolder", True 'call GetFilesInFolder sub
End Sub
      • IN
        Inês

        @ExcelBaby Hi! Thank you for this help 🙂
        Unfortunately that didn't work out. I still need the code to create a sheet to insert the data but it isn't loading only the 20 most recent instead it loads all files but only if I have already created the sheet

        • EX
          ExcelBaby (Author)

          @Inês The above sample code lists the last modified 20 XLS, XLSX, XLSM files in each folder on the current active worksheet. The code works fine, tested in excel 2021.
          please change line 75 with your folder and run the RunThisMacroToTest() sub to test.

          • IN
            Inês

            @ExcelBaby It's pdf format does that make a difference?

            • EX
              ExcelBaby (Author)

              @Inês If you only need PDF files, change line 37 with the following code:

              Case "PDF"    'Only get "PDF" files
          • IN
            Inês

            @ExcelBaby For me it only write the column name in the sheet. It does not give any file list :/

            • EX
              ExcelBaby (Author)

              @Inês If there is no file type to be listed in the folder you specified, it will not be listed, for example, you only want to list PDF files, but you specified XLSX files on line 37, in this case you have to replace Line 37 (the macro in this comment):

              Case "XLS", "XLSX", "XLSM"    'Get "XLS", "XLSX", "XLSM" files

              with:

              Case "PDF"    'list "PDF" files

              In VBE (Alt+F11), you can press F8 to step by step run the code and view the variables in the local window.

      • IN
        Inês

        @ExcelBaby Hi thank you 🙂
        Unfortunately this code didn't work. I still need the code to create a new sheet to pput the values but it doesn't give the last 20 items either

  4. CO
    Corey

    This is great!

    Is there a way to limit the level of subfolders it searches? Say my directory is c:\directory\seconddirectory\thirddirectory\fourthdirectory, and each folder in main directory may have multiple second, third and so on directories. Is there a way to get the search to stop at a certain level, like the 2nd or 3rd directory?

    • EX
      ExcelBaby (Author)

      @Corey For example, 1 level, replace line 37-40 with the following code, if you want list 2 level, change <=1 to <=2.

      For Each oSubfolder In oFolder.Subfolders   'loop all sub-folders
    If UBound(Split(oSubfolder.path, "\")) - UBound(Split(FSO.GetFolder(PathSpec), "\")) <= 1 Then '1 level
        queue.Add oSubfolder 'enqueue
    End If
    '...insert any folder processing code here...
Next oSubfolder
  5. CI
    Cian

    Great Code BTW
    Do you know how to add more file information in new columns (Specifically length/duration of video files).
    Thanks,

    • EX
      ExcelBaby (Author)

      @Cian You can use GetDetailsOf to get file details, insert line 61 (before End With): 

                      Select Case FileExtension
                    Case "MKV", "AVI", "MP4"
                            .Cells(LastBlankCell, 10) = GetLength(oFile)
                    Case Else
                End Select

      Then, paste the function into your module:

      Public Function GetLength(ByVal FileItem As Object) As Variant
    Dim objShell, objFolder, objFolderItem
    Set objShell = CreateObject("Shell.Application")
    Set objFolder = objShell.Namespace(FileItem.ParentFolder.path)
    Set objFolderItem = objFolder.ParseName(FileItem.Name)
    GetLength = objFolder.GetDetailsOf(objFolderItem, 27)   'video length
    Set objShell = Nothing
    Set objFolder = Nothing
    Set objFolderItem = Nothing
End Function
  6. KI
    Kieran

    Hi, i'm having an issue at line 42, where I get a 'Subscript out of range' error. I am using your same code and have only modified for the file directory. Do you know why this would be? Thanks in advance

  7. AN
    Andy

    Great code! Is there a way to get the code to continue beyond 28542 items? I have a collection of files slightly larger and it stops at the 28542 item. Thanks!

    • EX
      ExcelBaby (Author)

      @Andy Sorry, I don't know what your problem is. After local testing, this macro can list more than 35695 files in the folder I specify.

  8. MA
    Matt

    1)If I want to exclude a folder, can I add an if-statement to skip this folder and move to the next one? If so how would I code this?

    2) How can I skip the folders that I don't have access to "access denied" and list these folders on a separate tab?

    • EX
      ExcelBaby (Author)

      @Matt 1. add a sheet with name DeniedFolder
      2. Replace line 33-40 (Do While queue.Count > 0...Next oSubfolder) with below code:

          Dim DeniedNo As Long
    Dim ExcludeFolderPath As String
    Dim DeniedSheetName As String
    ExcludeFolderPath = ""  'Input your exclude folder path, E.g. "D:\MyWorkBooks\Art Work"
    DeniedSheetName = "DeniedFolder"    'which sheet you want to list access denied folder
    Do While queue.Count > 0
        Set oFolder = queue(1)

        On Error Resume Next
        For Each oSubfolder In oFolder.SubFolders   'loop all sub-folders
            If Err.Number = 70 Then 'access denied
                With ThisWorkbook.Sheets(DeniedSheetName)
                    DeniedNo = .Cells(Rows.Count, 1).End(xlUp).Row + 1 'get the last blank cell of column A
                    .Cells(DeniedNo, 1) = queue(1).Path 'Access Denied Folder Path
                End With
            Else
                If (oSubfolder <> ExcludeFolderPath) Then
                    queue.Add oSubfolder 'enqueue    '
                End If
            End If
            '...insert any folder processing code here...
        Next oSubfolder
        
        queue.Remove 1 'dequeue

      3. Input your exclude folder path, E.g. "D:\MyWorkBooks\Art Work" in code: ExcludeFolderPath = "D:\MyWorkBooks\Art Work"

  9. PH
    Phanichandra

    How can i have multiple file formats in the only certain file format code line.
    FileType = "mp4"

      • NI
        Nils

        @ExcelBaby I have the same question, is it possible to filter more than one filetype like "xls, xlsm, xltx"

        • EX
          ExcelBaby (Author)

          @Nils Replace line 23-25 with:

          Dim FileType As Variant
FileType = Array("xls", "xlsm", "xltx")

          Replace line 46 with:

          If (Application.Count(Application.Match(FileExtension, FileType, 0)) > 0) Then
  10. MA
    Marina

    Hi, Can you help me with the Macro that will do the same as this one but instead of listing on the file paths in one sheet, that each folder and subfolders get their own sheets with list of paths for files inside of them? Sheets name to be folders name? or just 1 2 3 4 ...

    thank you.

    • EX
      ExcelBaby (Author)

      @Marina 1. uncomment line 20, 21.
      2. insert after line 41 with following code:

              MySheetName = oFolder.Name   'Add a Sheet with folder name
        AddSheet (MySheetName)

      Full code:

      Sub ListFile()
    ''Description: List all files in folder and sub-folders (include hidden ,read only...)
    ''Web Site: https://excelbaby.com
    ''Url: https://excelbaby.com/learn/excel-macro-list-all-files-in-folders-and-subfolders/

    Dim PathSpec As String
    PathSpec = ""   'Specify a folder
    If (PathSpec = "") Then PathSpec = SelectSingleFolder   'Browse for Folder to select a folder

    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")    'Late Binding
    If (fso.FolderExists(PathSpec) = False) Then Exit Sub   'folder exist or not?

    Application.ScreenUpdating = False 'Disable Screen Updating to speed up macro
    
    Dim MySheetName As String
'    MySheetName = "Files"   'Add a Sheet with name "Files"
'    AddSheet (MySheetName)

    Dim FileType As String
    FileType = "*"   '*:all, or pdf, PDF, XLSX...
    FileType = UCase(FileType)

    Dim queue As Collection, oFolder As Object, oSubfolder As Object, oFile As Object
    Dim LastBlankCell As Long, FileExtension As String

    Set queue = New Collection
    queue.Add fso.GetFolder(PathSpec) 'enqueue
    
    Do While queue.Count > 0
        Set oFolder = queue(1)
        queue.Remove 1 'dequeue
        
        For Each oSubfolder In oFolder.SubFolders   'loop all sub-folders
            queue.Add oSubfolder 'enqueue
            '...insert any folder processing code here...
        Next oSubfolder
        
        MySheetName = oFolder.Name   'Add a Sheet with folder name
        AddSheet (MySheetName)
        
        LastBlankCell = ThisWorkbook.Sheets(MySheetName).Cells(Rows.Count, 1).End(xlUp).Row + 1 'get the last blank cell of column A
        
        For Each oFile In oFolder.Files 'loop all files
            FileExtension = UCase(Split(oFile.Name, ".")(UBound(Split(oFile.Name, ".")))) 'get file extension, eg: TXT
            If (FileType = "*" Or FileExtension = FileType) Then
                With ThisWorkbook.Sheets(MySheetName)
                    .Cells(LastBlankCell, 1) = oFile 'Path
                    .Cells(LastBlankCell, 2) = oFolder 'Folder
                    .Cells(LastBlankCell, 3) = oFile.Name 'File Name
                    .Cells(LastBlankCell, 4) = FileExtension 'File Extension
                    .Cells(LastBlankCell, 5) = oFile.DateCreated 'Data Created
                    .Cells(LastBlankCell, 6) = oFile.DateLastAccessed 'Last Accessed
                    .Cells(LastBlankCell, 7) = oFile.DateLastModified 'Last Modified
                    .Cells(LastBlankCell, 8) = oFile.Size 'File Size
                    If (oFile.Attributes And 2) = 2 Then
                        .Cells(LastBlankCell, 9) = "TRUE" 'Is Hidden
                    Else
                        .Cells(LastBlankCell, 9) = "FALSE" 'Is Hidden
                    End If
                End With
                LastBlankCell = LastBlankCell + 1
            End If
        Next oFile
    Loop
    
    'Cells.EntireColumn.AutoFit  'Autofit columns width
    Application.ScreenUpdating = True

End Sub
      • MA
        Marina

        @ExcelBaby Thank you so much.

        I downloaded the lates file here, and clicked on Alt+F11 to access the Developer tab/VBA editor. There were 4 windows there, one with code. I updated the code with the code above and after selecting my folder I got list of files and their paths inside separate sheets for each subfolder.

        Can you please also add for complete dummies that before opening Excel or anything with Macro as of lately they first have to right-click on the file, open properties and click on Unblock.

        Security:
        This file came from another computer and might be blocked to help protect this computer.
        - Unblock

        THANK YOU SO MUCH!!

          • MA
            Marina

            @ExcelBaby they will always have this warning, it is connected to file, not downloading. All files that have macro now Microsoft blocks them automatically, even my old files I had on my computer, I have to unblock them.

            Can you help with the situation of folders with same name, is there a way to add condition so it ads number to the sheet name (folder name) so it extracts the paths normally even if some folders have the same names? thank you.

      • MA
        Marina

        @ExcelBaby @ExcelBaby Hi, I was testing the script but if the two subfolders have inside folders with the same name the script fails because of the names. Any way of adding the "add number to name" in the script, so if the name is already used once, to put (1) (2) in the new sheets? Thank you.

        • EX
          ExcelBaby (Author)

          @Marina I don't think "add number to the name" is a good idea, if you have a lot of duplicate folders you won't be sure which worksheet you want to use, so I suggest uncommenting the Function AddSheet on line 95.

          'Worksheet(MySheetName).Cells.Delete

          This means that all files with the same folder name will be listed in the same worksheet. But again, this presents a problem, if you run this macro twice or more in the same workbook, the data will be duplicated, so you need to delete all worksheets except the active sheet (or a specific worksheet) before the macro runs. You can do this with a macro:

          1. copy the macro to the same module: Excel Macro: Delete All Worksheets Except Active One
          2. insert the following code in line 18 (after: Application.ScreenUpdating = False):

          call DeleteAllWorksheetsExceptActive
        • EX
          ExcelBaby (Author)

          @Marina If you need to "add numbers to names", the following code will work for you:

          Sub ListFile()
    ''Description: List all files in folder and sub-folders (include hidden ,read only...)
    ''Web Site: https://excelbaby.com
    ''Url: https://excelbaby.com/learn/excel-macro-list-all-files-in-folders-and-subfolders/

    Dim PathSpec As String
    PathSpec = ""   'Specify a folder
    If (PathSpec = "") Then PathSpec = SelectSingleFolder   'Browse for Folder to select a folder

    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")    'Late Binding
    If (fso.FolderExists(PathSpec) = False) Then Exit Sub   'folder exist or not?

    Application.ScreenUpdating = False 'Disable Screen Updating to speed up macro
    Dim MySheetName As String
'    MySheetName = "Files"   'Add a Sheet with name "Files"
'    AddSheet (MySheetName)

    Dim FileType As String
    FileType = "*"   '*:all, or pdf, PDF, XLSX...
    FileType = UCase(FileType)

    Dim queue As Collection, oFolder As Object, oSubfolder As Object, oFile As Object
    Dim LastBlankCell As Long, FileExtension As String

    Set queue = New Collection
    queue.Add fso.GetFolder(PathSpec) 'enqueue
    
    Do While queue.Count > 0
        Set oFolder = queue(1)
        queue.Remove 1 'dequeue
        
        For Each oSubfolder In oFolder.SubFolders   'loop all sub-folders
            queue.Add oSubfolder 'enqueue
            '...insert any folder processing code here...
        Next oSubfolder
        
        MySheetName = oFolder.Name   'Add a Sheet with folder name
        MySheetName = AddSheetName(MySheetName)
        
        LastBlankCell = ThisWorkbook.Sheets(MySheetName).Cells(Rows.Count, 1).End(xlUp).Row + 1 'get the last blank cell of column A
        
        For Each oFile In oFolder.Files 'loop all files
            FileExtension = UCase(Split(oFile.Name, ".")(UBound(Split(oFile.Name, ".")))) 'get file extension, eg: TXT
            If (FileType = "*" Or FileExtension = FileType) Then
                With ThisWorkbook.Sheets(MySheetName)
                    .Cells(LastBlankCell, 1) = oFile 'Path
                    .Cells(LastBlankCell, 2) = oFolder 'Folder
                    .Cells(LastBlankCell, 3) = oFile.Name 'File Name
                    .Cells(LastBlankCell, 4) = FileExtension 'File Extension
                    .Cells(LastBlankCell, 5) = oFile.DateCreated 'Data Created
                    .Cells(LastBlankCell, 6) = oFile.DateLastAccessed 'Last Accessed
                    .Cells(LastBlankCell, 7) = oFile.DateLastModified 'Last Modified
                    .Cells(LastBlankCell, 8) = oFile.Size 'File Size
                    If (oFile.Attributes And 2) = 2 Then
                        .Cells(LastBlankCell, 9) = "TRUE" 'Is Hidden
                    Else
                        .Cells(LastBlankCell, 9) = "FALSE" 'Is Hidden
                    End If
                End With
                LastBlankCell = LastBlankCell + 1
            End If
        Next oFile
    Loop
    
    'Cells.EntireColumn.AutoFit  'Autofit columns width
    Application.ScreenUpdating = True

End Sub

Function SelectSingleFolder()
    'Select a Folder Path
    
    Dim FolderPicker As FileDialog
    Dim myFolder As String
    
    'Select Folder with Dialog Box
    Set FolderPicker = Application.FileDialog(msoFileDialogFolderPicker)
    
    With FolderPicker
        .Title = "Select A Single Folder"
        .AllowMultiSelect = False
        If .Show <> -1 Then Exit Function 'Check if user clicked cancel button
        SelectSingleFolder = .SelectedItems(1)
    End With
End Function

Function AddSheetName(MySheetName As String)
    'Add a worksheet with custom name
    
    Dim Mysheet As Worksheet, F As Boolean
    For Each Mysheet In ThisWorkbook.Worksheets
        If Mysheet.Name = MySheetName Then
            Mysheet.Copy After:=Worksheets(Worksheets.Count)
            With ActiveSheet
                .Cells.Delete
                MySheetName = .Name
            End With
            F = True
            Exit For
        Else
            F = False
        End If
    Next
    
    If Not F Then Sheets.Add.Name = MySheetName
    'Add table header
    With Sheets(MySheetName)
        .Cells(1, 1) = "Path"
        .Cells(1, 2) = "Folder"
        .Cells(1, 3) = "File Name"
        .Cells(1, 4) = "File Extension"
        .Cells(1, 5) = "Data Created"
        .Cells(1, 6) = "Last Accessed"
        .Cells(1, 7) = "Last Modified"
        .Cells(1, 8) = "Size"
        .Cells(1, 9) = "Is Hidden"
    End With
    
    'return sheet name
    AddSheetName = MySheetName
End Function
  11. MA
    Marina

    Hi, is there a way to set it up so it gives list of file paths for each folder in an individual sheet, not all in one?

    In order to get the files, excel must be in the same folder as the folders we want to extract the list from?

    Thank you.

  12. DE
    Derrek

    Any chance you can post a link to a video as a template for how to do this?

    • PO
      Pon

      @Derrek It is great. May I know how to show the results to userform combobox? Thanks.

  13. SA
    Sam

    Does this work with Excel 2010? One the first time when I run this macro all directories work afterward only the last directory.

  14. SA
    Sam

    Only list files for one directory

  15. LE
    Lee

    I have tried it but there is an error with it at line 37
    For Each oSubfolder In oFolder.SubFolders
    queue.Add oSubfolder 'enqueue
    '...insert any folder processing code here...
    Next oSubfolder
    Pls fix it!

    • EX
      ExcelBaby (Author)

      @Lee Sorry, I don't understand your question, you can download the whole example test.
      Based on the code you provided, you don't need to insert any folder manipulation code in this example.