Excel VBA, Find and List All Files in a Directory and its Subdirectories

Previously in the article Find and List all Files and Folders in a Directory I’ve explained how you can use VBA to find and list all the files and folders in a specific directory. In this article I will explain how you can do the same, only this time you will get all the files in that directory and all its subdirectories. I will be using a recursive call to one my functions in order to implement this.


Get All Files:

When the user presses the “Get Files” button a folder dialog will open asking the user to select a directory:

Folder dialog
Upon selecting a directory the name of all the files in that directory and all its sub directories will printed in column A and B:

List of Files in Directory and subdirectories
The code for this program can be seen below:

Option Explicit
'the first row with data
Const ROW_FIRST As Integer = 5

'This is an event handler. It exectues when the user
'presses the run button
Private Sub btnGet_Click()
'determines if the user selects a directory
'from the folder dialog
Dim intResult As Integer
'the path selected by the user from the
'folder dialog
Dim strPath As String
'Filesystem object
Dim objFSO As Object
'the current number of rows
Dim intCountRows As Integer
Application.FileDialog(msoFileDialogFolderPicker).Title = _
"Select a Path"
'the dialog is displayed to the user
intResult = Application.FileDialog( _
msoFileDialogFolderPicker).Show
'checks if user has cancled the dialog
If intResult <> 0 Then
strPath = Application.FileDialog(msoFileDialogFolderPicker _
).SelectedItems(1)
'Create an instance of the FileSystemObject
Set objFSO = CreateObject("Scripting.FileSystemObject")

'loops through each file in the directory and prints their
'names and path
intCountRows = GetAllFiles(strPath, ROW_FIRST, objFSO)
'loops through all the files and folder in the input path
Call GetAllFolders(strPath, objFSO, intCountRows)
End If
End Sub

'''
'This function prints the name and path of all the files
'in the directory strPath
'strPath: The path to get the list of files from
'intRow: The current row to start printing the file names
'in
'objFSO: A Scripting.FileSystem object.
Private Function GetAllFiles(ByVal strPath As String, _
ByVal intRow As Integer, ByRef objFSO As Object) As Integer
Dim objFolder As Object
Dim objFile As Object
Dim i As Integer
i = intRow - ROW_FIRST + 1
Set objFolder = objFSO.GetFolder(strPath)
For Each objFile In objFolder.Files
'print file name
Cells(i + ROW_FIRST - 1, 1) = objFile.Name
'print file path
Cells(i + ROW_FIRST - 1, 2) = objFile.Path
i = i + 1
Next objFile
GetAllFiles = i + ROW_FIRST - 1
End Function

'''
'This function loops through all the folders in the
'input path. It makes a call to the GetAllFiles
'function. It also makes a recursive call to itself
'strFolder: The folder to loop through
'objFSO: A Scripting.FileSystem object
'intRow: The current row to print the file data on
Private Sub GetAllFolders(ByVal strFolder As String, _
ByRef objFSO As Object, ByRef intRow As Integer)
Dim objFolder As Object
Dim objSubFolder As Object

'Get the folder object
Set objFolder = objFSO.GetFolder(strFolder)
'loops through each file in the directory and
'prints their names and path
For Each objSubFolder In objFolder.subfolders
intRow = GetAllFiles(objSubFolder.Path, _
intRow, objFSO)
'recursive call to to itsself
Call GetAllFolders(objSubFolder.Path, _
objFSO, intRow)
Next objSubFolder
End Sub


Code Explanation:

The function below executes when the user presses the “Get File” button:

Private Sub btnGet_Click()
...
End Sub

The next few lines of the code is related to the folder dialog:

Application.FileDialog(msoFileDialogFolderPicker).Title = _
"Select a Path"
'the dialog is displayed to the user
intResult = Application.FileDialog( _
msoFileDialogFolderPicker).Show
'checks if user has cancled the dialog
If intResult <> 0 Then
'dispaly message box
strPath = Application.FileDialog(msoFileDialogFolderPicker _
).SelectedItems(1)
...
End If

Basically it displays a folder dialog, and checks the user action. For more information about using Folder Dialogs please see the article below:

The call to the function GetAllFiles, will print all the files in the directory specified. Note that it returns the index of the last row, so the next call to the function will know which row to start printing the file names:

intCountRows = GetAllFiles(strPath, ROW_FIRST, objFSO)

The function itself has previously been explained in the article below:

The next line of code in the btnGet_Click event handler makes a call to the GetAllFolders function. This function loops through all the folders in the directory passed to it. For each directory it finds it calls the function GetAllFiles for that directory. It then makes a recursive call to itself, passing that folder as an input parameter.

The line below gets the folder object associated with the path passed as an input parameter to the function:

Set objFolder = objFSO.GetFolder(strFolder)

The for each loop below iterates through all the folders in the current folder:

For Each objSubFolder In objFolder.subfolders
...
Next objSubFolder

The call to the function GetAllFiles prints the name of all the files in the current folder:

intCountRows = GetAllFiles(strPath, ROW_FIRST, objFSO)

The line below is a recursive call to the GetAllFolders function.

Call GetAllFolders(strPath, objFSO, intCountRows)

You can download the file and code related to this article from the link below:

See also:

If you need assistance with your code, or you are looking for a VBA programmer to hire feel free to contact me. Also please visit my website www.software-solutions-online.com

32 thoughts on “Excel VBA, Find and List All Files in a Directory and its Subdirectories”

  1. Alan Lewis says:

    Thank you for sharing this amazing script! It has been tremendous help and saved many hours of labor. Cheers!

    1. pedrumj says:

      No problem, glad I could help 🙂

  2. johno says:

    Great script

    1. pedrumj says:

      glad you found it useful 🙂

  3. johno says:

    how would you change the code to search for a particular file type say *.pdf only. thanks

    1. pedrumj says:

      You would need to use string processing to find the files that end with “.pdf”. Throw me a mail and I will provide further assistance on this issue.

    2. Don says:

      This simple modification seemed to work for me …

      Private Function GetAllFiles(ByVal strPath As String, _
      ByVal intRow As Integer, ByRef objFSO As Object) As Integer
      Dim objFolder As Object
      Dim objFile As Object
      Dim i As Integer
      i = intRow – ROW_FIRST + 1
      Set objFolder = objFSO.GetFolder(strPath)
      For Each objFile In objFolder.Files
      ‘print file name
      If InStr(1, objFile, “.pdf”) > 0 Then ‘Added by Don, filter by PDF files ONLY
      Cells(i + ROW_FIRST – 1, 1) = objFile.Name
      ‘print file path
      Cells(i + ROW_FIRST – 1, 2) = objFile.Path
      i = i + 1
      End If
      Next objFile
      GetAllFiles = i + ROW_FIRST – 1
      End Function

  4. Jake says:

    Thank you very much for this script, had used it to find all files and folders in a specified folder. Then using the returned addresses used a shell command to del any location which had “archive” within it’s address (essential for the task I have). Problem I then discovered was the above wasn’t actually returning ALL files, it was missing some but if I started my search further into the folder structure it came back with the results but obviously only then a subsection of what was wanted. Sometimes also coming up with run-time error ‘1004’. Also on the files i run it on it seems to stop at 145 returns. Any ideas? I used your code purely and unchanged, separated the delete part out into different sub which has been to manually called.

    1. Jake says:

      My bad, had:
      i = intRow – ROW_FIRST + 1
      As
      i = intRow – ROW_FIRST – 1

      Caused some troubles.

  5. craig Schultz says:

    Hi, This Macro is exactly what I’m looking for thank you but unfortunately I cant get it to work?

    I have downloaded ‘Find and list, in directories and subdirectories.xlsm’

    I have disabled Macros, but the button doesn’t seem to work? Not sure if I’m doing something wrong?

    Hope you can help?

    Thanks very much

    Craig

  6. Trish says:

    Hey, this is great. I am trying to just come up with a list of subfolder names and subsequent subfolder names so I can use them in a drop-down menu on another worksheet, and actually generate the files list based on the selected subfolder. I have the macro for the latter part working. The macro for getting the subfolder names ONLY is a bit trickier, and I am only getting the current directory subfolders. I am actually populating three separate tables based on three separate worksheets, so it makes it a bit more complicated. I put the table names and drive mappings into a 2D array, and then go through the array so that it populates the corresponding table. That all works just fine. Here is my code. Any suggestions:
    Sub ListMyDir()
    ‘This updates the tables in the “Starting Directory List” so they can be used in the drop down menus
    ‘on the other worksheets to select a starting directory to list files from
    ‘Setup variables
    Dim tblrow As Integer
    Dim myTable As ListObject
    Dim MyArray As Variant
    Dim MyArrayTable As String
    Dim MyArrayDir As String
    Dim x As Integer
    Set myTable = ActiveSheet.ListObjects(“EA_Libraries_Data”)
    MyArray = myTable.DataBodyRange
    On Error Resume Next
    ‘Loop through list of tables
    For x = 1 To 3
    ‘Set starting row number for table
    tblrow = 1
    ‘Set the table name and directory
    MyArrayTable = MyArray(x, 1)
    MyArrayDir = MyArray(x, 2)
    ‘Empty the existing table contents
    ActiveSheet.ListObjects(MyArrayTable).DataBodyRange.Delete
    ‘Get directory information
    Set MyObject = New Scripting.FileSystemObject
    Set mySource = MyObject.GetFolder(MyArrayDir)
    ‘Add Drive Letter as first row entry
    ActiveSheet.ListObjects(MyArrayTable).ListRows.Add AlwaysInsert:=True
    ActiveSheet.ListObjects(MyArrayTable).DataBodyRange(tblrow, 1).Value = MyArrayDir
    tblrow = tblrow + 1
    ‘Loop through the directory adding subfolder names
    For Each MySubfolder In mySource.SubFolders
    ActiveSheet.ListObjects(MyArrayTable).ListRows.Add AlwaysInsert:=True
    ActiveSheet.ListObjects(MyArrayTable).DataBodyRange(tblrow, 1).Value = MySubfolder
    tblrow = tblrow + 1
    Next
    Next x
    End Sub

  7. Amjad says:

    Hey this is great

    im looking for this prgramme …but i need the file in access. because it contain around 5 lakh file names

  8. Allan says:

    Hi, Thanks for an excellent script. How do we make a contribution by way of thanks? Even to charity if you have no need.
    One issue that I encountered – I have quite a few files and hit overflow at 32764. I changed i to Long (and ROW_FIRST) but still hit an issue at the same point.
    A solution would be great but it’s a very useful script regardless.
    Regards, Allan

    1. Adam says:

      Allan,
      Perhaps it is a little late for you but I ran into the same issue. The solution for me was to replace all instances of “As Integer” to “As Long”. Hope this helps you or others experiencing the same issue with this otherwise fantastic script!

  9. Enes says:

    Great code thanks for sharing.
    I have question regarding error handling. i cant get grasp on how to bypass folders i dont have access to.
    I’m tring to pull all file names from share drive with more than 50 characters in file name. all working good but when i hit folder that i dont have access i’m getting error.

    Can you help with this

    Thank you

  10. murali says:

    HI, i was looking for this kind of script, this really saved lot of my time. Thank you very much….

  11. Aaron says:

    Hi, This is a very powerful script; when modified it has so much functionality. Thanks a lot for this!!!!!!!!

  12. Jack says:

    Thank you very much for sharing this.

    How can you modify the code to follow the criteria below:
    – Only open .xlsx files
    – Extract values from certain cells in the file

    Please advise:

    sName = Dir(sPath &”*.xlsx”)’ for xl2010 & “*.xlsx?”
    DoWhile sName “”‘Loop until filename is blank
    Set bk = Workbooks.Open(sPath & sName)
    sh.Cells(rw,”A”)= bk.Name
    sh.Cells(rw,”B”)= bk.Worksheets(1).Range(“B8″)
    sh.Cells(rw,”C”)= bk.Worksheets(1).Range(“B12”)

  13. Mark says:

    Hello, I don’t normal code in VB so having a bit of difficulty with this. I am trying to get the script to work on a network path several levels deep, each level has file and folders beyond the root directory on the share.

    the path I want to use would be \\xyz\R&D\PSE_PKG

    I am not sure how to place or utilize the script you have created in my excel sheet.

    Also is it possible to combine two scripts? – code as follows

    \\first code sample
    Sub Example2()
    Dim objFSO As Object
    Dim objFolder As Object
    Dim objSubFolder As Object
    Dim i As Integer

    ‘Create an instance of the FileSystemObject
    Set objFSO = CreateObject(“Scripting.FileSystemObject”)
    ‘Get the folder object
    Set objFolder = objFSO.GetFolder(“\\server\RandD\R and D\PSE-PKG\Complete Stroke Care-new Pkg components”)
    i = 1
    ‘loops through each file in the directory and prints their names and path
    For Each objSubFolder In objFolder.subfolders
    ‘print folder name
    Cells(i + 1, 1) = objSubFolder.Name
    ‘print folder path
    Cells(i + 1, 2) = objSubFolder.Path
    i = i + 1
    Next objSubFolder
    End Sub

    \\second code sample
    Sub Example1()
    Dim objFSO As Object
    Dim objFolder As Object
    Dim objFile As Object
    Dim i As Integer

    ‘Create an instance of the FileSystemObject
    Set objFSO = CreateObject(“Scripting.FileSystemObject”)
    ‘Get the folder object
    Set objFolder = objFSO.GetFolder(“\\server\RandD\R and D\PSE-PKG\Complete Stroke Care-new Pkg components”)
    i = 1
    ‘loops through each file in the directory and prints their names and path
    For Each objFile In objFolder.Files
    ‘print file name
    Cells(i + 1, 1) = objFile.Name
    ‘print file path
    Cells(i + 1, 2) = objFile.Path
    i = i + 1
    Next objFile
    End Sub

    Thanks,

    Mark

  14. Frank says:

    This is what I have been looking for works grate. It picks up the desktop.ini file any way to block that?
    Thanks a lot

  15. Elias says:

    Hi,

    Great code! Thanks for making it available!
    I just have one question. If I want to control which sheet the list gets printed on. Currently it´s the active sheet but I would like to adjust it so it always prints on a specified sheet, no matter what´s currently active.
    Is it possible? and if so, how?

    Thanks!

  16. o.vl. says:

    Good code, but fails when a root folder, select c: d: or something.

    I have that issue with similar code does not work when a unit is selected

  17. Jose says:

    Excellent, thanks a lot for sharing!

    Would it be possible to make the macro to retrieve other data for the files?

    I want to retrieve creation date and file size, for instance, this is to check for duplicated files with different names.

    Thanks a lot,

    Jose

  18. PteJack says:

    Thank you for sharing this code. It almost worked for me out of the box, however I’m accessing over 700,000 files on a drive.
    First
    As this was written assigning variables to 16bit Integers, as soon as the line count hit 32766, the output wrapped back to row 1, line 1. I fixed that by changing the 16 bit integers to 32bit longs.
    Second
    The next thing I added was error handling for access denied files and folders.
    I added these 2 error traps to the getFolders and getFiles functions

    On Error Goto Err1

    Err1:
    Debug.Print Err.Description, Err.Number
    ‘catch Permission denied errors
    If Err.Number 70 Then
    eio = eio – 1
    If eio < 0 Then eioi = 1
    Resume Next
    Else
    Denied = Denied + 1
    End If
    Resume Next

    On Error Goto Err2
    Err2:
    Debug.Print Err.Description, Err.Number
    'catch Permission denied errors
    If Err.Number 70 Then
    ei2 = ei2 – 1
    If ei2 < 0 Then ei2 = 1
    Resume Next
    Else
    Denied = Denied + 1
    End If
    Resume Next

    I gave each there own trap, just in case

    Finally, because I'm accessing so many files I wanted to be able to work on other spreadsheets on my machine and did not want this routine to freeze, in the event I had to ctrl+Break the process. To fix that, I added a DoEvents statement just before the Next objFile and Next objSubFolder statements of the 2 functions.

    But other than that, this is now doing what I need it to do, a few more modifications to pull the other elements out of the filesystemobjects and it will be perfect.

    Again, thank you for sharing. I was scratching my head trying to figure a way to do this without caching everything to arrays.

    1. Lisa says:

      Would you be able to send me what your code looks like not after you added the above? I am having the same issues.

      1. Lisa says:

        Sorry bad morning…

        Would you be able to send me what your code looks like after you added the above? I am having the same issues.

  19. Tim says:

    Has anyone been able to find a way for the macro to pull Author info? All I hear in the boards are that it needs to be a Shell to pull Author info. Is there a way to incorporate this into the above macro?
    I tried adding this to the GetAllFiles function but doesn’t work.

    Private Function GetAllFiles(ByVal strPath As String, _
    ByVal intRow As Integer, ByRef objFSO As Object) As Integer
    Dim objFolder As Object
    Dim objFile As Object
    Dim i As Integer

    i = intRow – ROW_FIRST + 1
    Set objFolder = objFSO.getfolder(strPath)
    ‘On Error Resume Next
    For Each objFile In objFolder.Files
    ‘print Date created
    Cells(i + ROW_FIRST – 1, 1) = objFile.DateCreated
    ‘print file name
    Cells(i + ROW_FIRST – 1, 2) = objFile.Name

    ‘Author
    Cells(i + ROW_FIRST – 1, 2).Select
    Debug.Print objFolder.GetDetailsOf(objFile, 6)

    ‘print file path
    Cells(i + ROW_FIRST – 1, 4) = objFile.Path
    ‘Insert doc link
    Cells(i + ROW_FIRST – 1, 5).Select
    ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:= _
    objFile.Path, _
    TextToDisplay:=objFile.Name

    i = i + 1
    Next objFile
    GetAllFiles = i + ROW_FIRST – 1
    End Function

  20. SenoritaEmeP says:

    Thank you so much – I use this constantly to analyze patch files.