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
About these ads
    • Casey
    • January 21st, 2012

    What is the licence for this code?

      • alext9586
      • January 21st, 2012

      That’s up to the original author of the code to decide.

    • nev
    • May 4th, 2012

    That is kinda long…

    • Adilson Nascimento – Curitiba – Parana State – Brazil
    • October 20th, 2013

    Dear Havrda,
    Congratulations for sharing your genius code!!!
    Today i’m very happy with your code, its working!! after FileSearch missing in excel 2007, i used some script to list only files in Current Directories, not in sub directories.
    Now, my problem was solved.
    You’re the guy!

    Um grande abraço!
    Adilson

  1. No trackbacks yet.

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s

Follow

Get every new post delivered to your Inbox.

Join 103 other followers

%d bloggers like this: