VBA Application.FileSearch replacement
Microsoft, in their infinite wisdom, removed the function Application.FileSearch from Office 2007′s Visual Basic macro library. This function was mainly used to find files in a directory. It worked in previous version of Office so I don’t know the reason for removal. There is apparently a lot of bitching about the deprecation of it on the internet.
I found the best solution here at the MSDN Forums. The following code was written by a member of the forum; it works as an elegant solution to the missing function Application.FileSearch in Office 2007. The subroutine starts in the current directory (where the sheet the macro is stored is saved to) and looks in the current directory and subfolders for other Excel files.
Sub SrchForFiles() ' ' Example of FileSearchByHavrda procedure calling as replacement of missing FileSearch function in the newest MS Office VBA ' 01.06.2009, Author: P. Havrda, Czech Republic ' Dim FileNameWithPath As Variant Dim ListOfFilenamesWithParh As New Collection ' create a collection of filenames ' Filling a collection of filenames (search Excel files including subdirectories) ' ActiveWorkbook.path returns the current directory Call FileSearchByHavrda(ListOfFilenamesWithParh, ActiveWorkbook.path, "*.xls", True) Dim z As Long Dim ws As Worksheet ' prevents data from flashing Application.ScreenUpdating = False Set ws = ThisWorkbook.Worksheets.Add(Sheets(1)) On Error GoTo 1 2: ws.Name = "FileSearch Results" ' Print list to immediate debug window and as a message window For Each FileNameWithPath In ListOfFilenamesWithParh ' cycle for list(collection) processing ' Print down the first column (A) z = z + 1 ws.Cells(z, 1) = FileNameWithPath Next FileNameWithPath ' Print to immediate debug window and message if no file was found If ListOfFilenamesWithParh.Count = 0 Then Debug.Print "No file was found !" MsgBox "No file was found !" End If Application.ScreenUpdating = True Exit Sub 1: Application.DisplayAlerts = False Worksheets("FileSearch Results").Delete Application.DisplayAlerts = True GoTo 2 End Sub Private Sub FileSearchByHavrda(pFoundFiles As Collection, pPath As String, pMask As String, pIncludeSubdirectories As Boolean) ' ' Search files in Path and create FoundFiles list(collection) of file names(path included) accordant with Mask (search in subdirectories if enabled) ' 01.06.2009, Author: P. Havrda, Czech Republic ' Dim DirFile As String Dim CollectionItem As Variant Dim SubDirCollection As New Collection ' Add backslash at the end of path if not present pPath = Trim(pPath) If Right(pPath, 1) <> "\" Then pPath = pPath & "\" ' Searching files accordant with mask DirFile = Dir(pPath & pMask) Do While DirFile <> "" pFoundFiles.Add pPath & DirFile 'add file name to list(collection) DirFile = Dir ' next file Loop ' Procedure exiting if searching in subdirectories isn't enabled If Not pIncludeSubdirectories Then Exit Sub ' Searching for subdirectories in path DirFile = Dir(pPath & "*", vbDirectory) Do While DirFile <> "" ' Add subdirectory to local list(collection) of subdirectories in path If DirFile <> "." And DirFile <> ".." Then If ((GetAttr(pPath & DirFile) And vbDirectory) = 16) Then SubDirCollection.Add pPath & DirFile DirFile = Dir 'next file Loop ' Subdirectories list(collection) processing For Each CollectionItem In SubDirCollection Call FileSearchByHavrda(pFoundFiles, CStr(CollectionItem), pMask, pIncludeSubdirectories) ' Recursive procedure call Next End Sub
It results with a new worksheet named “FileSearch Results” with something similar to the following data:
C:\Users\Alex\Desktop\excel_macro\the.xls C:\Users\Alex\Desktop\excel_macro\quick\brown.xls C:\Users\Alex\Desktop\excel_macro\fox\jumps.xls C:\Users\Alex\Desktop\excel_macro\over\the\lazy.xls C:\Users\Alex\Desktop\excel_macro\dog.xls C:\Users\Alex\Desktop\excel_macro\to\eat.xls C:\Users\Alex\Desktop\excel_macro\her\babies\food.xls