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

2010

10/12

POSTED BY

alext9586

CATEGORY

VBA

TAGS

2003
2007
Code
Example
macro
office
programming
vba
windows

Write comment