Application.FileSearch

Removed in Office 2007
Office 97 introduced a FileSearch object (enhanced in 2002) that allows you to search and maintain files easily.
This allows you to search for files with a wide range of search criteria such as file type, file size, file location and date of last modification.
This object can be found in the Office library.

Application.FileSearch 

The FileSearch object basically gives you all the functionality of the (File > Open) dialog box
You can use FileSearch instead of using the earlier Dir() function.


Types of Objects

FileTypes - In 97 and 2000 you could only specify a single FileType property. Office 2002 introduced a FileTypes collection that allows you to specify multiple file types.
FoundFiles collection - All the matching file names are placed in this collection.
PropertyTests -
SearchScopes collection - (Added 2002)
ScopeFolders - (Added 2002)
SearchFolders - (Added 2002)


Example

Dim iFileCount As Integer 
Dim objFileSearch As Variant

Set objFileSearch = Application.FileSearch
objFileSearch.LookIn = "C:\Temp\"
objFileSearch.FileType = msoFileType.msoFileTypeExcelWorkbooks

If objFileSearch.Execute(msoSortBy.msoSortbyFileName, _
                         msoSortOrder.msoSortOrderAscending) > 0 Then
   For iFileCount = 1 To objFileSearch.FoundFiles.Count

   Next iFileCount
Else
   Call MsgBox ("There were no files found.")
End If


Key Properties and Methods

FileNamespecifies the name of the file to be found (wildcards can be used)
FoundFileReturns a FileSystem object that contains the names of the files that have been found
LookInSpecifies the directory to be searched
SearchSubFoldersReturns True if subdirectories are to searched
ExecutePerforms the search
NewSearchResets the FileSearch object to its default settings. All property values are retained after each search is run, and by using the NewSearch method you can selectively set properties for the next file search without manually resetting previous property values.


Any files found are placed in a FoundFiles collection

Private Sub SearchAFolder() 
Dim sfolderpath As String
Dim sextension As String
Dim objfilesearch As Variant
Dim vobjfile As Variant
Dim sfullname As String
   
   Set objfilesearch = Application.FileSearch
   
   With objfilesearch
      .NewSearch
      .LookIn = "C:\Temp\"
      .SearchSubFolders = False
      .FileType = msoFileType.msoFileTypeAllFiles
      .LastModified = msoLastModifiedToday
      .Execute
      
'for each control variable must be variant or object
      For Each vobjfile In .FoundFiles
         sfullname = CStr(vobjfile)
         If Right(sfullname, 3) = ".bmp" Then
         End If
      Next vobjfile
      
   End With
End Sub


List all the files in the root directory

Private Sub FileFinder() 
Dim objFile As Variant
   With Application.FileSearch
      .LookIn = "C:\"
      .FileType = msoFileType.msoFileTypeAllFiles
      .Execute
      For Each objFile in .FoundFiles
         Call MsgBox(objFile)
      Next objFile
   End With
End Sub


Return most recent file from a folder

Dim sfullname As String 

   With Application.FileSearch
      .LookIn = "C:\"
      .FileName = ""
      If .Execute(msoSortByLastModified, _
                  msoSortOrderDescending, True) > 0 Then
          sfullname = .FoundFiles(1)
      End If
   End With


Application.FileSearch - Class

Dim pLookIn As String 
Dim pSearchSubFolders As Boolean
Dim pFileName As String

Public FoundFiles As New Collection
        
Public Property Get LookIn() As String
    LookIn = pLookIn
End Property
Public Property Let LookIn(value As String)
    pLookIn = value
End Property
Public Property Get SearchSubFolders() As Boolean
    LookIn = pSearchSubFolders
End Property
Public Property Let SearchSubFolders(value As Boolean)
    pSearchSubFolders = value
End Property
Public Property Get fileName() As String
    fileName = pFileName
End Property
Public Property Let fileName(value As String)
    pFileName = value
End Property
Public Function Execute() As Long
    
        Dim ex As Long
        Dim sLookIn As String
        Dim sDirName As String
        Dim sSubDir As String
        Dim sFileName As String
        Dim ff As FilesFound
    
            Set ff = New FilesFound
            sLookIn = LookIn
            sDirName = Dir(sLookIn, vbDirectory)
            sFileName = Dir(sLookIn & "\", vbNormal)
            Do Until Len(sFileName) = 0
                If sFileName Like fileName Then
                    ff.AddFile sLookIn, sFileName
                    FoundFiles.Add (ff.FoundFileFullName)
                End If
                sFileName = Dir
            Loop
            If SearchSubFolders Then
                Do Until Len(sDirName) = 0
                    If GetAttr(sLookIn & sDirName) = vbDirectory Then
                        sSubDir = sDirName
                        Do Until Len(sFileName) = 0
                            If GetAttr(sDirName) = vbNormal Then
                                sFileName = sDirName
                                ff.AddFile sDirName, sFileName
                                FoundFiles.Add (ff)
                            End If
                        Loop
                    End If
                    sDirName = Dir
                Loop
            End If
    
    Execute = FoundFiles.Count
    
End Function

The second I named FilesFound and the code is as follows:

Public FoundFileFullName As String

Public Function AddFile(path As String, fileName As String)
    FoundFileFullName = path & "\" & fileName
End Function



To use it in your code just create the two class modules and then use it as such:


    Dim sFile as String 
    Dim fs As New FileSearh

    With fs
        .LookIn = sPath
        .SearchSubFolders = True
        .fileName = "*"
        If .Execute > 0 Then
            For i = 1 To .FoundFiles.Count
                sFile = .FoundFiles(i)
' your code here

            Next
        End If
    End With


Example 2

Sub FileSearchByHavrda_Example_of_procedure_calling() 

Dim FileNameWithPath As Variant
Dim ListOfFilenamesWithParh As New Collection ' create a collection of filenames

' Filling a collection of filenames (search Excel files including subdirectories)
Call FileSearchByHavrda(ListOfFilenamesWithParh, "C:\Temp", "*.xls", True)

' Print list to immediate debug window and as a message window
For Each FileNameWithPath In ListOfFilenamesWithParh ' cycle for list(collection) processing
        Debug.Print FileNameWithPath & Chr(13)
        MsgBox FileNameWithPath & Chr(13)
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

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



Application.FileSearch - Replacement

Set objCollection = Folder_GetFilesDirToCollection("C:\Temp\", "FileName_With_Wildcards*.csv") 
      
Public Function Folder_GetFilesDirToCollection(ByVal sFolderPath As String, _
                                               ByVal sPattern As String) As Collection
Dim objCollection As Collection
Dim sFileName As String
   On Error GoTo AnError
      
   sFileName = Dir(sFolderPath & sPattern)
   Set objCollection = New Collection
   Do While Len(sFileName) > 0
      objCollection.Add (sFileName)
      sFileName = Dir()
   Loop
   Set Folder_GetFilesDirToCollection = objCollection
   Exit Function
      
AnError:
   Call MsgBox(Err.Number & " - " & Err.Description)
End Function
Need code to get the last modified file
 
Public Function Folder_GetFileLastModified(ByVal sFolderPath As String, _
                                           ByVal sPattern As String) As String
Dim objCollection As Collection
Dim sFileName As String
Dim dtLastModified As Date
Dim sLastModified As String
   On Error GoTo AnError
            
   sFileName = Dir(sFolderPath & sPattern)
   Set objCollection = New Collection
   sLastModified = sFileName
   
   dtLastModified = DateSerial(2010, 1, 1)
   
   Do While Len(sFileName) > 0
      If (FileDateTime(sFolderPath & sFileName) > dtLastModified) Then
         sLastModified = sFileName
      End If
      objCollection.Add (sFileName & "-" & FileDateTime(sFolderPath & sFileName))
      sFileName = Dir()
   Loop
       
   Folder_GetFileLastModified = sLastModified
   Exit Function
      
AnError:
   Call MsgBox(Err.Number & " - " & Err.Description)
End Function
 
Public Sub Test_sPopulateHistory()
Dim vaFiles As Variant
vaFiles = Folder_GetFilesLastModifiedToArray("C:\Temp\", "FileName_With_Wildcards*.csv")
Stop
End Sub

Public Function Folder_GetFilesLastModifiedToArray(ByVal sFolderPath As String, _
                                                   ByVal sPattern As String) As Variant
Dim vaFiles() As Variant
Dim vaFilesCopy() As Variant
Dim sFileName As String
Dim iarraycount As Integer
   On Error GoTo AnError
            
   sFileName = Dir(sFolderPath & sPattern)
   ReDim Preserve vaFiles(1, 2000)
      
   Do While Len(sFileName) > 0
      vaFiles(0, iarraycount) = sFileName
      vaFiles(1, iarraycount) = FileDateTime(sFolderPath & sFileName)
      sFileName = Dir()
      iarraycount = iarraycount + 1
   Loop
       
   If iarraycount > 0 Then
      ReDim Preserve vaFiles(1, iarraycount - 1)
      ReDim Preserve vaFilesCopy(1, iarraycount - 1)
   
      For iarraycount = 0 To UBound(vaFiles, 2)
         vaFilesCopy(0, iarraycount) = vaFiles(0, UBound(vaFiles, 2) - iarraycount)
         vaFilesCopy(1, iarraycount) = vaFiles(1, UBound(vaFiles, 2) - iarraycount)
      Next iarraycount
   End if

   Folder_GetFilesLastModifiedToArray = vaFilesCopy
   Exit Function
      
AnError:
   Call MsgBox(Err.Number & " - " & Err.Description)
End Function



© 2017 Better Solutions Limited. All Rights Reserved. © 2017 Better Solutions Limited

PrevNext