Anyone got a good function to loop through all Sub Folders and Files?

[MartinSmith]

Sorry I am feeling lazy today, but I am sure it must be a fairly common thing to want to do so hopefully someone out there has some code that will do this?

[Mortivan]

It's slow, but it works.

Option Explicit

Dim mlFileNum As Long
Dim msFile() As String

Sub main()

ReDim msFile(1 To 100) As String

Dim lX As Long
Dim sStartPath As String

sStartPath = InputBox("What is the starting folder?")

FindFiles sStartPath

For lX = 1 To mlFileNum
    Debug.Print msFile(lX)
Next lX

Debug.Print mlFileNum & " files found."
Debug.Print

End Sub


Sub FindFiles(ByVal sPath As String)

Dim sNext As String
Dim sDir() As String
Dim lDirNum As Long
Dim lX As Long

ReDim sDir(1 To 50) As String

lDirNum = 0

If Right(sPath, 1) <> "\" Then sPath = sPath + "\"

sNext = Dir(sPath, vbDirectory)
    
Do
    Do While Left(sNext, 1) = "."
        sNext = Dir
    Loop
    
    If sNext = "" Then Exit Do
    
    If (GetAttr(sPath + sNext) And vbDirectory) = vbDirectory Then
        
        If lDirNum Mod 50 = 0 Then
            ReDim Preserve sDir(1 To lDirNum + 50) As String
        End If
            
        lDirNum = lDirNum + 1
        sDir(lDirNum) = sPath + sNext
    Else
        
        If mlFileNum Mod 100 = 0 Then
            ReDim Preserve msFile(1 To mlFileNum + 100) As String
        End If
        
        mlFileNum = mlFileNum + 1
        msFile(mlFileNum) = sPath + sNext
    End If
    
    sNext = Dir
Loop

For lX = 1 To lDirNum
    FindFiles (sDir(lX))
Next lX

End Sub

-mort

[Nucleus]

In a module

Option Explicit
 
Private Const MAX_PATH = 260
Private Const FILE_ATTRIBUTE_DIRECTORY = &H10
 
Public Type FILETIME
        dwLowDateTime As Long
        dwHighDateTime As Long
End Type
 
Public Type WIN32_FIND_DATA
        dwFileAttributes As Long
        ftCreationTime As FILETIME
        ftLastAccessTime As FILETIME
        ftLastWriteTime As FILETIME
        nFileSizeHigh As Long
        nFileSizeLow As Long
        dwReserved0 As Long
        dwReserved1 As Long
        cFileName As String * MAX_PATH
        cAlternate As String * 14
End Type
 
Public Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
Public Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Public Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
 
Private files()          As String
 
Public Function EnumFiles(ByVal Path As String, Optional Subdirectories As Boolean = False) As Variant
 'Nucleus
 ReDim files(1 To 1)
 Call EF(Path, Subdirectories)
 
 If Len(files(1)) Then EnumFiles = files Else EnumFiles = Null
 Erase files
End Function
 
Private Sub EF(ByVal Path As String, Optional Subdirectories As Boolean = False)
 Dim hFirstFound         As Long
 Dim hFound              As Long
 Dim WFD                 As WIN32_FIND_DATA
 Dim fname               As String
 
 If Right$(Path, 1) <> "\" Then Path = Path & "\"
 hFirstFound = FindFirstFile(Path & "*.*", WFD)
 hFound = (hFirstFound > 0)
 Do While hFound
    fname = Left(WFD.cFileName, InStr(1, WFD.cFileName, Chr(0)) - 1)
    If fname <> "." And fname <> ".." Then
    
        If WFD.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY Then
            
            If Subdirectories Then Call EF(Path & fname, Subdirectories)
        
        Else
        
            If Len(files(1)) Then ReDim Preserve files(1 To UBound(files) + 1)
            files(UBound(files)) = Path & fname
            
        End If
        
    End If
    
    hFound = FindNextFile(hFirstFound, WFD)
 Loop
 
 FindClose hFirstFound
End Sub

Usage:

Private Sub Command2_Click()
Dim a As Variant, i As Long
 
a = EnumFiles("c:\tmp", True)
 
If Not IsNull(a) Then
   For i = 1 To UBound(a)
      Debug.Print a(i)
   Next i
Else
    MsgBox "No files found in that directory matching " & _
        "the extension if you passed one."
End If
End Sub

[MartinSmith]

Thank you both very much, that was exactly what I needed.

I'm not normally that lazy (honestly)

[filburt1]

It could be faster if you try to use the *gag* FileSystemObject.

[Nucleus]

Originally posted by filburt1
It could be faster if you try to use the *gag* FileSystemObject.

Are you sure it is faster when app is compiled? I haven't taken the time to compare compiled version vs fso, but it would be interesting to see a comparison.

[filburt1]

My guess is that it would be a bit faster, as MS wrote the FSO in C or C++.

[Nucleus]

As it is mostly calls directly to the API speed should be quite comparable even though FSO is in C++. Speed would also depend on the implementation, which is why I would like to see a comparison, perhaps it is possible to tweak the implementation to outdo the fso?