A frequent request one runs into is for some way in which one can apply some change to all the files in a folder. This case presents a modularized solution. While the implementation may look complex -- it does use a recursive routine to process sub-folders -- the result is a "black box" that should be used without any modification.
An example of how one would use the code is below. The ListAllFiles subroutine is the main code routine. It calls the "black box" module named searchForFiles with the appropriate arguments, one of which is a 'callback' routine. In this example, the callback routine is named writeFilesToSheet. To change the callback to the processOneFile routine, uncomment the first reference to searchForFiles and comment out the 2nd.
Option Explicit
Sub ListAllFiles()
'searchForFiles "c:\tushar\temp\", "processOneFile", "*.*", True, True
searchForFiles "l:\tushar\temp\", "writefilestosheet", "*.*", True, True
End Sub
Sub processOneFile(ByVal aFilename As String)
Debug.Print aFilename
End Sub
Sub writeFilesToSheet(ByVal aFilename As String)
With ActiveSheet
.Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0).Value = aFilename
End With
End Sub
Copy the code below into a standard module in your Visual Basic project. At the bottom is the example from above. The solution uses one application specific method, the Run method. Consequently, it can be used on any platform that supports the Run method. These applications include -- but may not be limited to -- Excel, Word, and PowerPoint.
Option Explicit
'A modularized solution to process all files in a folder, _
and optionally all subfolders in the folder _
Tushar Mehta -- modified based on comments from Mario D'Alessio
'There should be absolutely no reason to modify the searchForFiles _
subroutine. Treat it as a blackbox routine. Do *not* tweak it for _
each specific search.
'How to use the subroutine: _
Call it with the five arguments: _
DirToSearch: The directory you want to search. _
ProcToCall: This is the callback procedure called with the full _
name of each file found _
FileTypeToFind: This is a search pattern for the files sought. _
For example, to find all Excel files use "*.xls". _
This argument is optional and defaults to "*.*" (or all files) _
SearchSubDir: Boolean that specifies whether or not to search nested _
folders. The default is False. _
FilesFirst: Boolean that specifies if the files for a particular folder _
are processed before the subfolders are processed. _
The default is False, which means the subfolders are processed first.
'The callback subroutine is where you process each file found. _
The signature for the routine should be _
Sub subroutine-name (ByVal aFilename As String)
'Use this callback subroutine to do whatever it is you want to do with each _
file found. For two examples, see the processOneFile and the _
writeFilesToSheet subroutine below.
Private Sub processFiles(ByVal DirToSearch As String, _
ByVal ProcToCall As String, _
ByVal FileTypeToFind As String)
Dim aFile As String
aFile = Dir(DirToSearch & FileTypeToFind)
Do While aFile <> ""
Application.Run ProcToCall, DirToSearch & aFile
aFile = Dir()
Loop
End Sub
Private Sub processSubFolders(ByVal DirToSearch As String, _
ByVal ProcToCall As String, _
ByVal FileTypeToFind As String, _
ByVal SearchSubDir As Boolean, _
ByVal FilesFirst As Boolean)
Dim aFolder As String, SubFolders() As String
ReDim SubFolders(0)
aFolder = Dir(DirToSearch, vbDirectory)
Do While aFolder <> ""
If aFolder <> "." And aFolder <> ".." Then
If (GetAttr(DirToSearch & aFolder) And vbDirectory) _
= vbDirectory Then
SubFolders(UBound(SubFolders)) = aFolder
ReDim Preserve SubFolders(UBound(SubFolders) + 1)
End If
End If
aFolder = Dir()
Loop
If UBound(SubFolders) <> LBound(SubFolders) Then
Dim I As Long
For I = LBound(SubFolders) To UBound(SubFolders) - 1
searchForFiles _
DirToSearch & SubFolders(I), _
ProcToCall, FileTypeToFind, SearchSubDir, FilesFirst
Next I
End If
End Sub
Sub searchForFiles(ByVal DirToSearch As String, ByVal ProcToCall As String, _
Optional ByVal FileTypeToFind As String = "*.*", _
Optional ByVal SearchSubDir As Boolean = False, _
Optional ByVal FilesFirst As Boolean = False)
On Error GoTo ErrXIT
If Right(DirToSearch, 1) <> Application.PathSeparator Then _
DirToSearch = DirToSearch & Application.PathSeparator
If FilesFirst Then processFiles DirToSearch, ProcToCall, FileTypeToFind
If SearchSubDir Then processSubFolders DirToSearch, ProcToCall, _
FileTypeToFind, SearchSubDir, FilesFirst
If Not FilesFirst Then _
processFiles DirToSearch, ProcToCall, FileTypeToFind
Exit Sub
ErrXIT:
MsgBox "Fatal error: " & Err.Description & " (Code=" & Err.Number & ")"
Exit Sub
End Sub
'The sample code below should be in a separate module than the above code. _
Modify and run the ListAllFiles routine
#If False Then
Option Explicit
Sub ListAllFiles()
searchForFiles "c:\tushar\temp\", "processOneFile", "*.*", True, True
End Sub
Sub processOneFile(ByVal aFilename As String)
Debug.Print aFilename
End Sub
Sub writeFilesToSheet(ByVal aFilename As String)
With ActiveSheet
.Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0).Value = aFilename
End With
End Sub
#End If
