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

[trishcollins]

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")
        Else
        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")
            Else
            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
            mytbl.DataBodyRange.Delete
    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
    Next
'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)
        Next
    End If
End Sub

 

[Rijnsent]

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
    Next
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,

Koen