Looping through all folders and subfolders in a drive and listing files


New Member
Jan 7, 2006
I need to be able to list all files in all folders and subfolders in a particular drive (I use this macro to populate three different tables depending on the drive, so thus the mytbl and myPath variables. I also have it set to use a named range to determine whether or not to include subdirectories, therefor IncludeSub, which is normally set to "TRUE").

This code appears to work and populates the table with the correct information, but it seems to skip folders and files, even those containing files. I have full access to all the files and folders in all the drives. There doesn't seem to be any pattern, such as skipping empty folders or skipping folders where the path exceeds 256 characters. Any other ideas?

Sub ListFiles()
'Setup Display Variables
'    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.Calculation = xlCalculationManual
    Application.DisplayStatusBar = True
    Application.StatusBar = "Importing Beehive File Names"
'Setup Variables
    Dim tblrow As Integer
    Dim mytbl As ListObject
    Dim MyPath As Range
    Dim includesub As Range
    Dim files As Integer
'Determine variables used based on the active sheet calling the function
    If ActiveSheet.Name = "EASv2 Library" Then
        Set mytbl = ActiveSheet.ListObjects("EASv2")
        Set MyPath = Range("EASv2_Starting_Folder")
        Set includesub = Range("EASv2_Subfolders")
        If ActiveSheet.Name = "EA WIP Library" Then
            Set mytbl = ActiveSheet.ListObjects("EA_WIP")
            Set MyPath = Range("EA_WIP_Starting_Folder")
            Set includesub = Range("EA_WIP_Subfolders")
            If ActiveSheet.Name = "EA Official Library" Then
                Set mytbl = ActiveSheet.ListObjects("EA_Official")
                Set MyPath = Range("EA_Official_Starting_Folder")
                Set includesub = Range("EA_Official_Subfolders")
            End If
        End If
    End If
    MsgBox "This macro will replace the current contents of the table to include all files starting in the subfolder indicated"
    tblrow = 1
    files = 1
'    On Error Resume Next
'Delete contents of existing table
    If mytbl.ListRows.Count > 0 Then
    End If
'Call subroutine to populate table and pass variables
    MsgBox MyPath & " " & includesub & " " & tblrow & " " & mytbl & " " & files
    Call ListMyFiles(MyPath, includesub, tblrow, mytbl, files)
    MsgBox "The update has been completed"
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Application.StatusBar = ""
    Application.Calculation = xlCalculationAutomatic
End Sub
Sub ListMyFiles(mySourcePath, IncludeSubfolders, tblrow, mytbl, files)
'Get info on directory and files
    Set MyObject = New Scripting.FileSystemObject
    Set mySource = MyObject.GetFolder(mySourcePath)
    On Error Resume Next
'Loop through each file and populate a row of the table
    For Each myFile In mySource.files
        Application.StatusBar = "Importing Beehive File Names  " & files
        mytbl.ListRows.Add AlwaysInsert:=True
        mytbl.DataBodyRange(tblrow, 1).Value = mySourcePath
        mytbl.DataBodyRange(tblrow, 2).Value = myFile.Name
        mytbl.DataBodyRange(tblrow, 3).Value = myFile.Size
        mytbl.DataBodyRange(tblrow, 4).Value = myFile.DateLastModified
        mytbl.DataBodyRange(tblrow, 5).Value = myFile.Type
        tblrow = tblrow + 1
        files = files + 1
'Loop though to include next subfolder if variable is set to do so
    If IncludeSubfolders Then
        For Each MySubfolder In mySource.SubFolders
'            MsgBox "My Current Subfolder:  " & MySubfolder.Path
            Call ListMyFiles(MySubfolder.Path, True, tblrow, mytbl, files)
    End If
End Sub


Well-known Member
Oct 17, 2005
Office Version
Hi Trish,
mmm, I had a go at it, ran it on my laptop and it seemed to work all fine, the file count matched the one of my Explorer. What I would try (did it here, but as I have no missing files it's not possible to replicate it for you):
-is the "missing out" consistent? As in: if you run the macro twice, would you miss the same directory/files?
-next, run a simple version of your code just on that bit. So say you find a directory that won't show up in your results, run the "for each MySubFolder in mysource.Subfolders". I would use debug.print to get the results directly in the Direct window (without the possibility of the table messing things up by e.g. overwriting older entries). -> e.g.
Sub TestMissingFolders()
    mySourcePath = "C:\path\hives\"
    Set MyObject = New Scripting.FileSystemObject
    Set mySource = MyObject.GetFolder(mySourcePath)
    For Each MySubfolder In mySource.SubFolders
        debug.print MySubfolder.Path
End Sub
-and a hunch: what about file/folder names (before the extension) longer then 8 characters? Windows used to transform them into filena~1.xls names, might that be the ones giving trouble?

Curious to hear what caused the missing items,


Forum statistics

Latest member

Some videos you may like

This Week's Hot Topics

  • populate from drop list with multiple tables
    Hi All, i have a drop list that displays data, what i want is when i select one of those from the list to populate text from different tables on...
  • Find list of words from sheet2 in sheet1 before a comma and extract text vba
    Hi Friends, Trying to find the solution on my task. But did not find suitable one to the need. Here is my query and sample file with details...
  • Dynamic Formula entry - VBA code sought
    Hello, really hope one of you experts can help with this - i've spent hours on this and getting no-where. .I have a set of data (more rows than...
  • Listbox Header
    Have a named range called "AccidentsHeader" Within my code I have: [CODE]Private Sub CommandButton1_Click() ListBox1.RowSource =...
  • Complex Heat Map using conditional formatting
    Good day excel world. I have a concern. Below link have a list of countries that carries each country unique data. [URL...
  • Conditional formatting
    Hi good morning, hope you can help me please, I have cells P4:P54 and if this cell is equal to 1 then i want row O to say "Fully Utilised" and to...