VB and VBA Users Source Code: Finding the matching files in a directory using Excel's FileSearch object
[
Home
|
Contents
|
Search
|
Reply
| Previous | Next ]
VB/VBA Source Code
Finding the matching files in a directory using Excel's FileSearch object
By:
Andrew Baker
Email (spam proof):
Email the originator of this post
Date:
Friday, July 13, 2001
Hits:
805
Category:
Unspecified
Article:
The following code demonstrates a simple method for finding matching files in a folder/sub folders, using Excel's FileSearch object. Option Explicit 'Purpose : Finds matching files in a specified folder/sub folders. 'Inputs : sSearchPath The path to search for the matching files. ' sFileFilter The file pattern matching string (use a semi colan to specify multiple patterns - eg "*.txt;*.xls"). ' bSearchSubFolders If True will search all the sub folders in the specified directory. 'Outputs : Returns an array of matching files, else returns empty if no matching files where found. 'Author : Andrew Baker 'Date : 13/Jul/2001 'Keywords : FileFind, FindFile Function FilesFindMatching(sSearchPath As String, Optional sFileFilter As String = "*.*", Optional bSearchSubFolders As Boolean = False) As Variant Dim lThisFile As Long, lFound As Long, asFiles() As String If DirExists(sSearchPath) = False Then Debug.Print "THE DIRECTORY '" & sSearchPath & "' DOES NOT EXIST!!!" Debug.Assert False FilesFindMatching = Empty Exit Function End If With Application.FileSearch 'Initialise variables .LookIn = sSearchPath .Filename = sFileFilter .SearchSubFolders = bSearchSubFolders 'Perform search lFound = .Execute(msoSortByFileName, msoSortOrderAscending, True) If lFound Then 'Populate result array ReDim asFiles(1 To lFound) For lThisFile = 1 To lFound asFiles(lThisFile) = .FoundFiles(lThisFile) Next 'Return results FilesFindMatching = asFiles Else 'No matching files FilesFindMatching = Empty End If End With End Function 'Purpose : Check if a Path Exists 'Inputs : sPath The path to check 'Outputs : Returns True if the path exists, False if it doesn't 'Author : Andrewb 'Date : 17/08/2000 'Notes : 'Revisions : Function DirExists(ByVal sPath As String) As Boolean If sPath <> ".." And sPath <> "." And sPath <> "\" And Len(sPath) > 0 Then If Right$(sPath, 1) <> "\" Then sPath = sPath & "\" End If On Error Resume Next DirExists = (GetAttr(sPath) And vbDirectory) > 0 On Error GoTo 0 End If End Function 'Demonstration routine 'Returns all the files found in C:\ into the ActiveSheet Sub Test() Dim avFiles As Variant, lThisFile As Long avFiles = FilesFindMatching("C:\MyTestDir", "*.xls;*.txt;*.bat") 'Write array values to range If IsEmpty(avFiles) = False Then With ActiveSheet .Range(.Cells(1), .Cells(UBound(avFiles), 1)).Value = Application.WorksheetFunction.Transpose(avFiles) End With End If End Sub
Terms and Conditions
Support this site
Download a trial version of the Excel Workbook Rebuilder
