Excel 2010: VBA replacement for Application.FileSearch

vendetta81

New Member
Joined
Jun 27, 2012
Messages
5
Hi!

First off I am a noob at VBA and I have been trying to fix this issue myself by reading other threads. Sucks Application.Filesearch is gone, I could at least figure that coding out. It is not going very well. The following code is pasted below. If somebody is kind enough to please provide me a solution for this code. Many thanks in advance!!!



With Application.FileSearch
.NewSearch
.LookIn = Path4
.FileType = msoFileTypeWordDocuments
If .Execute > 0 Then
'if word docs are present in the folder
Workbooks.Open Main4 & Form4
Application.Run "'C:\MISC\Macro.xls'!Module.Start"
Workbooks(Form4).Close savechanges:=True
Workbooks(FormResults4).Close savechanges:=True
Else
End If
End With
 
I think you need to pass your Foundfiles to the FIndFiles function so it can add to this collection, else FoundFiles will be empty. Then you can iterate through it as per your code.
 
Upvote 0

Excel Facts

Pivot Table Drill Down
Double-click any number in a pivot table to create a new report showing all detail rows that make up that number
Thank you very much for this function Mohammad Basem. I just have a small question. Is it possible to define two or more file types in sFileSpec? And is it also possible to define several file names, this function explicitely searches for (I have a lot of folders, which also contain files of the same name, but with different content, but those folders also include several other files, so I only want to find all those which I defined).

Thanks
 
Upvote 0
…Is it possible to define two or more file types in sFileSpec? And is it also possible to define several file names…

Apologise for not being able to respond earlier.

Below is a new version of the ‘FindFiles’ function. The new version ‘fnFindFiles’ searches multiple file specs and consider hidden files and folders.

Please see the code for details on how to use it. It would be better copying the code to a separate module.

I didn’t test this code extensively, so your comments and feedback would be appreciated.

Code:
[FONT=Consolas][SIZE=2][COLOR=Navy]Option Explicit
[COLOR=Green]'
' Information collected for each found file
'[/COLOR]
Public Type gstrFoundFileInfo
   Path As String
   Name As String
End Type
 
Function fnFindFiles(ByVal sPath As String, _
   ByRef strFoundFiles() As gstrFoundFileInfo, _
   ByRef lFilesFound As Long, _
   Optional ByVal sPattern As String = "*.*", _
   Optional ByVal blIncludeHidden As Boolean = True, _
   Optional ByVal blIncludeSubFolders As Boolean = True) As Boolean
[COLOR=Green]'
' fnFindFiles
' ———————————
' Finds all files matching the specified file spec starting from the specified path and
'  searches sub-folders if required.
'
' Reference required
' ——————————————————
' Microsoft Scripting Runtime
'
' Parameters
' ——————————
' sPath (String): Start-up folder, e.g. "C:\Users\Username\Documents"
'
' strFoundFiles (User-defined data type): A user-defined dynamic array to store the path
'  and name of found files. The dimension of this array is (1 To nnn), where nnn is the
'  number of found files. The elements of this array are:
'   .Path (String) = File path
'   .Name (String) = File name
'
' lFilesFound (Long): Number of found files.
'
' sPattern (String): Multi-spec of files to be returned. Separate the different specs by
'  semicolon ‘;’ without spaces, e.g. "*.txt;abcdef?.doc?;jkl*.*"
'  Optional parameter with default value = "*.*", that is all files.
'
' blIncludeHidden (Boolean): Specify whether to search and return hidden folders and files or not.
'  Optional parameter with default value = True, which means hidden folders and files are returned.
'
' blIncludeSubFolders (Boolean): Specify whether to search sub-folders or not.
'  Optional parameter with default value = True, which means sub-folders will be searched.
'
' Return values
' —————————————
' True: One or more files found and
'  strFoundFiles  = Array of paths and names of all found files
'  lFilesFound    = Number of found files
' False: No files found and
'  lFilesFound = 0
'
' ———————————————————————————————————————————————————————————————————
' Using the function (sample code)
' ———————————————————————————————————————————————————————————————————
'
'   Dim lFilesNum As Long
'   Dim lCount As Long
'   Dim strMyFiles() As gstrFoundFileInfo
'   Dim blFilesFound As Boolean
'
'   blFilesFound = fnFindFiles("C:\Users\MBA\Desktop", _
'      strMyFiles, lFilesNum, "*.tx?;co*.xl*", False, True)
'   If blFilesFound Then
'      For lCount = 1 To lFilesNum
'         With strMyFiles(iCount)
'            MsgBox "Path:" & vbTab & .sPath & _
'               vbNewLine & "Name:" & vbTab & .sName, _
'               vbInformation, "Find Files"
'         End With
'      Next lCount
'   Else
'      MsgBox "No file(s) found matching the specified file specs.", _
'         vbInformation, "Find Files"
'   End If
'
' ———————————————————————————————————————————————————————————————————
'[/COLOR]
   Dim lCount As Long         [COLOR=Green]' Counter for found files[/COLOR]
   Dim bSpec As Byte          [COLOR=Green]' File spec counter[/COLOR]
   Dim blInclude As Boolean   [COLOR=Green]' Include hidden folder or file[/COLOR]
   Dim blFound As Boolean     [COLOR=Green]' Matching files found in current folder[/COLOR]
   Dim sFileSpec() As String  [COLOR=Green]' File specs to find[/COLOR]
 
[COLOR=Green]   ' File system objects[/COLOR]
   Dim fsObj As FileSystemObject
   Dim oParentFolder As Object
   Dim oFolder As Object
   Dim oFile As Object
 
   sFileSpec = Split(sPattern, ";")
   Set fsObj = New FileSystemObject
   On Error Resume Next
   Set oParentFolder = fsObj.GetFolder(sPath)
   If oParentFolder Is Nothing Then
      On Error GoTo 0
      fnFindFiles = False
[COLOR=Green]      ' Clean-up[/COLOR]
      Set oParentFolder = Nothing
      Set fsObj = Nothing
      Exit Function
   End If
   sPath = IIf(Right(sPath, 1) = "\", sPath, sPath & "\")
[COLOR=Green]   ' Check if any of the file specs exists in the target folder ‘sPath’[/COLOR]
   For bSpec = LBound(sFileSpec) To UBound(sFileSpec)
      blFound = Dir(sPath & sFileSpec(bSpec), vbNormal + IIf(blIncludeHidden, vbHidden, 0)) <> ""
      If blFound Then Exit For
   Next bSpec
[COLOR=Green]   ' Find files[/COLOR]
   If blFound Then         [COLOR=Green]' Folder not empty and has at least one of the specified file specs[/COLOR]
      lCount = UBound(strFoundFiles)         [COLOR=Green]' Initialise files counter[/COLOR]
      For Each oFile In oParentFolder.Files
         blInclude = IIf(blIncludeHidden, True, (oFile.Attributes And vbHidden) = 0)
         For bSpec = LBound(sFileSpec) To UBound(sFileSpec)
[COLOR=Green]            ' Check if the file ‘oFile’ matches any of the specified specs[/COLOR]
            If LCase(oFile.Name) Like LCase(sFileSpec(bSpec)) And blInclude Then
               lCount = lCount + 1
               ReDim Preserve strFoundFiles(1 To lCount)
               With strFoundFiles(lCount)
                  .Path = sPath
                  .Name = oFile.Name
               End With
               Exit For       [COLOR=Green]' Get next file[/COLOR]
            End If
         Next bSpec
      Next oFile
   End If
   If blIncludeSubFolders Then
[COLOR=Green]      ' Select next sub-folder[/COLOR]
      For Each oFolder In oParentFolder.SubFolders
         blInclude = IIf(blIncludeHidden, True, (oFolder.Attributes And vbHidden) = 0)
         If blInclude Then
            fnFindFiles oFolder.Path, strFoundFiles, lFilesFound, sPattern, _
               blIncludeHidden, blIncludeSubFolders
         End If
      Next
   End If
   fnFindFiles = UBound(strFoundFiles) > 0
   lFilesFound = UBound(strFoundFiles)
   On Error GoTo 0
 
[COLOR=Green]   ' Clean-up[/COLOR]
   Set oFile = Nothing           [COLOR=Green]' Although it is Nothing[/COLOR]
   Set oFolder = Nothing         [COLOR=Green]' Although it is Nothing[/COLOR]
   Set oParentFolder = Nothing
   Set fsObj = Nothing
 
End Function[/COLOR][/SIZE][/FONT]
 
Upvote 0
Great thread, and great code @MohammedBasem.

One question: Any ideas if I want to get the last modified files in a particular directory? I want to get the latest files that have been modified in a directory. If you have any tips on how to modify your code, please share your thoughts.

Thanks!

Apologise for not being able to respond earlier.

Below is a new version of the ‘FindFiles’ function. The new version ‘fnFindFiles’ searches multiple file specs and consider hidden files and folders.

Please see the code for details on how to use it. It would be better copying the code to a separate module.

I didn’t test this code extensively, so your comments and feedback would be appreciated.

Code:
[FONT=Consolas][SIZE=2][COLOR=Navy]Option Explicit
[COLOR=Green]'
' Information collected for each found file
'[/COLOR]
Public Type gstrFoundFileInfo
   Path As String
   Name As String
End Type
 
Function fnFindFiles(ByVal sPath As String, _
   ByRef strFoundFiles() As gstrFoundFileInfo, _
   ByRef lFilesFound As Long, _
   Optional ByVal sPattern As String = "*.*", _
   Optional ByVal blIncludeHidden As Boolean = True, _
   Optional ByVal blIncludeSubFolders As Boolean = True) As Boolean
[COLOR=Green]'
' fnFindFiles
' ———————————
' Finds all files matching the specified file spec starting from the specified path and
'  searches sub-folders if required.
'
' Reference required
' ——————————————————
' Microsoft Scripting Runtime
'
' Parameters
' ——————————
' sPath (String): Start-up folder, e.g. "C:\Users\Username\Documents"
'
' strFoundFiles (User-defined data type): A user-defined dynamic array to store the path
'  and name of found files. The dimension of this array is (1 To nnn), where nnn is the
'  number of found files. The elements of this array are:
'   .Path (String) = File path
'   .Name (String) = File name
'
' lFilesFound (Long): Number of found files.
'
' sPattern (String): Multi-spec of files to be returned. Separate the different specs by
'  semicolon ‘;’ without spaces, e.g. "*.txt;abcdef?.doc?;jkl*.*"
'  Optional parameter with default value = "*.*", that is all files.
'
' blIncludeHidden (Boolean): Specify whether to search and return hidden folders and files or not.
'  Optional parameter with default value = True, which means hidden folders and files are returned.
'
' blIncludeSubFolders (Boolean): Specify whether to search sub-folders or not.
'  Optional parameter with default value = True, which means sub-folders will be searched.
'
' Return values
' —————————————
' True: One or more files found and
'  strFoundFiles  = Array of paths and names of all found files
'  lFilesFound    = Number of found files
' False: No files found and
'  lFilesFound = 0
'
' ———————————————————————————————————————————————————————————————————
' Using the function (sample code)
' ———————————————————————————————————————————————————————————————————
'
'   Dim lFilesNum As Long
'   Dim lCount As Long
'   Dim strMyFiles() As gstrFoundFileInfo
'   Dim blFilesFound As Boolean
'
'   blFilesFound = fnFindFiles("C:\Users\MBA\Desktop", _
'      strMyFiles, lFilesNum, "*.tx?;co*.xl*", False, True)
'   If blFilesFound Then
'      For lCount = 1 To lFilesNum
'         With strMyFiles(iCount)
'            MsgBox "Path:" & vbTab & .sPath & _
'               vbNewLine & "Name:" & vbTab & .sName, _
'               vbInformation, "Find Files"
'         End With
'      Next lCount
'   Else
'      MsgBox "No file(s) found matching the specified file specs.", _
'         vbInformation, "Find Files"
'   End If
'
' ———————————————————————————————————————————————————————————————————
'[/COLOR]
   Dim lCount As Long         [COLOR=Green]' Counter for found files[/COLOR]
   Dim bSpec As Byte          [COLOR=Green]' File spec counter[/COLOR]
   Dim blInclude As Boolean   [COLOR=Green]' Include hidden folder or file[/COLOR]
   Dim blFound As Boolean     [COLOR=Green]' Matching files found in current folder[/COLOR]
   Dim sFileSpec() As String  [COLOR=Green]' File specs to find[/COLOR]
 
[COLOR=Green]   ' File system objects[/COLOR]
   Dim fsObj As FileSystemObject
   Dim oParentFolder As Object
   Dim oFolder As Object
   Dim oFile As Object
 
   sFileSpec = Split(sPattern, ";")
   Set fsObj = New FileSystemObject
   On Error Resume Next
   Set oParentFolder = fsObj.GetFolder(sPath)
   If oParentFolder Is Nothing Then
      On Error GoTo 0
      fnFindFiles = False
[COLOR=Green]      ' Clean-up[/COLOR]
      Set oParentFolder = Nothing
      Set fsObj = Nothing
      Exit Function
   End If
   sPath = IIf(Right(sPath, 1) = "\", sPath, sPath & "\")
[COLOR=Green]   ' Check if any of the file specs exists in the target folder ‘sPath’[/COLOR]
   For bSpec = LBound(sFileSpec) To UBound(sFileSpec)
      blFound = Dir(sPath & sFileSpec(bSpec), vbNormal + IIf(blIncludeHidden, vbHidden, 0)) <> ""
      If blFound Then Exit For
   Next bSpec
[COLOR=Green]   ' Find files[/COLOR]
   If blFound Then         [COLOR=Green]' Folder not empty and has at least one of the specified file specs[/COLOR]
      lCount = UBound(strFoundFiles)         [COLOR=Green]' Initialise files counter[/COLOR]
      For Each oFile In oParentFolder.Files
         blInclude = IIf(blIncludeHidden, True, (oFile.Attributes And vbHidden) = 0)
         For bSpec = LBound(sFileSpec) To UBound(sFileSpec)
[COLOR=Green]            ' Check if the file ‘oFile’ matches any of the specified specs[/COLOR]
            If LCase(oFile.Name) Like LCase(sFileSpec(bSpec)) And blInclude Then
               lCount = lCount + 1
               ReDim Preserve strFoundFiles(1 To lCount)
               With strFoundFiles(lCount)
                  .Path = sPath
                  .Name = oFile.Name
               End With
               Exit For       [COLOR=Green]' Get next file[/COLOR]
            End If
         Next bSpec
      Next oFile
   End If
   If blIncludeSubFolders Then
[COLOR=Green]      ' Select next sub-folder[/COLOR]
      For Each oFolder In oParentFolder.SubFolders
         blInclude = IIf(blIncludeHidden, True, (oFolder.Attributes And vbHidden) = 0)
         If blInclude Then
            fnFindFiles oFolder.Path, strFoundFiles, lFilesFound, sPattern, _
               blIncludeHidden, blIncludeSubFolders
         End If
      Next
   End If
   fnFindFiles = UBound(strFoundFiles) > 0
   lFilesFound = UBound(strFoundFiles)
   On Error GoTo 0
 
[COLOR=Green]   ' Clean-up[/COLOR]
   Set oFile = Nothing           [COLOR=Green]' Although it is Nothing[/COLOR]
   Set oFolder = Nothing         [COLOR=Green]' Although it is Nothing[/COLOR]
   Set oParentFolder = Nothing
   Set fsObj = Nothing
 
End Function[/COLOR][/SIZE][/FONT]
 
Upvote 0
Hi FairDune,

I have a version that returns the size, date created, date modified and attributes. It is under development, not thoroughly tested and I'm really not very much satisfied with its output.

It returns an array of all found files, just like fnFindFiles, but you have to do the filtering in your code.

If this is suitable for you then let me know to post it for you.
 
Upvote 0
Here is a new version of FindFile, which is far more solid, reliable and easy to use than the previous one posted earlier, as it doesn't rely on the Dir function. Please replace the previous code with this one.

Please read the instructions on how to use it in the beginning of the code.
Code:
[FONT=Consolas][SIZE=2][COLOR=Navy]Option Explicit

[COLOR=Green]'*
'* Properties that will be collected for each found file
'*[/COLOR]
Type FoundFileInfo
    sPath As String
    sName As String
End Type

Function FindFiles(ByVal sPath As String, _
    ByRef recFoundFiles() As FoundFileInfo, _
    ByRef iFilesFound As Integer, _
    Optional ByVal sFileSpec As String = "*.*", _
    Optional ByVal blIncludeSubFolders As Boolean = False) As Boolean
[COLOR=Green]'
' FindFiles
' ---------
' Finds all files matching the specified file spec starting from the specified path and
' searches sub-folders if required.
'
' Parameters
' ----------
' sPath (String): Start-up folder, e.g. "C:\Users\Username\Documents"
'
' recFoundFiles (User-defined data type): a user-defined dynamic array to store the path
' and name of found files. The dimension of this array is (1 To nnn), where nnn is the
' number of found files. The elements of this array are:
'   .sPath (String) = File path
'   .sName (String) = File name
'
' iFilesFound (Integer): Number of files found.
'
' sFileSpec (String): Optional parameter with default value = "*.*"
'
' blIncludeSubFolders (Boolean): Optional parameter with default value = False
'   (which means sub-folders will not be searched)
'
' Return values
' -------------
' True: One or more files found, therefore
'   recFoundFiles = Array of paths and names of all found files
'   iFilesFound = Number of found files
' False: No files found, therefore
'   iFilesFound = 0
'
' Using the function (sample code)
' --------------------------------
'    Dim iFilesNum As Integer
'    Dim iCount As Integer
'    Dim recMyFiles() As FoundFileInfo
'    Dim blFilesFound As Boolean
'
'    blFilesFound = FindFiles("C:\Users\MBA\Desktop", _
'        recMyFiles, iFilesNum, "*.txt?", True)
'    If blFilesFound Then
'        For iCount = 1 To iFilesNum
'            With recMyFiles(iCount)
'                MsgBox "Path:" & vbTab & .sPath & _
'                    vbNewLine & "Name:" & vbTab & .sName, _
'                    vbInformation, "Found Files"
'            End With
'        Next
'    Else
'        MsgBox "No file(s) found matching the specified file spec.", _
'            vbInformation, "File(s) not Found"
'    End If
'
'
' Constructive comments and Reporting of bugs would be appreciated.
'[/COLOR]

    Dim iCount As Integer           [COLOR=Green]'* Multipurpose counter[/COLOR]
    Dim sFileName As String         [COLOR=Green]'* Found file name[/COLOR]
[COLOR=Green]    '*
    '* FileSystem objects[/COLOR]
    Dim oFileSystem As Object, _
        oParentFolder As Object, _
        oFolder As Object, _
        oFile As Object

    Set oFileSystem = CreateObject("Scripting.FileSystemObject")
    On Error Resume Next
    Set oParentFolder = oFileSystem.GetFolder(sPath)
    If oParentFolder Is Nothing Then
        FindFiles = False
        On Error GoTo 0
        Set oParentFolder = Nothing
        Set oFileSystem = Nothing
        Exit Function
    End If
    sPath = IIf(Right(sPath, 1) = "\", sPath, sPath & "\")
[COLOR=Green]    '*
    '* Find files[/COLOR]
    sFileName = Dir(sPath & sFileSpec, vbNormal)
    If sFileName <> "" Then
        For Each oFile In oParentFolder.Files
            If LCase(oFile.Name) Like LCase(sFileSpec) Then
                iCount = UBound(recFoundFiles)
                iCount = iCount + 1
                ReDim Preserve recFoundFiles(1 To iCount)
                With recFoundFiles(iCount)
                    .sPath = sPath
                    .sName = oFile.Name
                End With
            End If
        Next oFile
        Set oFile = Nothing         [COLOR=Green]'* Although it is nothing[/COLOR]
    End If
    If blIncludeSubFolders Then
[COLOR=Green]        '*
        '* Select next sub-forbers[/COLOR]
        For Each oFolder In oParentFolder.SubFolders
            FindFiles oFolder.Path, recFoundFiles, iFilesFound, sFileSpec, blIncludeSubFolders
        Next
    End If
    FindFiles = UBound(recFoundFiles) > 0
    iFilesFound = UBound(recFoundFiles)
    On Error GoTo 0
[COLOR=Green]    '*
    '* Clean-up[/COLOR]
    Set oFolder = Nothing           [COLOR=Green]'* Although it is nothing[/COLOR]
    Set oParentFolder = Nothing
    Set oFileSystem = Nothing

End Function[/COLOR][/SIZE][/FONT]

Dear Mohammad,
Is there any reference required for the code above? I receive compile error, "user type not defined" highlighted line is "Dim recMyFiles() As FoundFileInfo. "
 
Upvote 0
Hi merveak,

Did you copy the whole code? The declaration of the type FoundFileInfo is on top of the code

Now I do not receive any error, however the code does not work either. I am not familiar with coding, I do not know exactly what to copy/ change on my code;

Here is the code that I need to change:

With Application.FileSearch
.LookIn = sPDFPath 'arama yapılan dizin
.SearchSubFolders = False 'alt klasörler aransın mı
'.FileType = msoFileTypeExcelWorkbooks aranacak dosya türleri
.Filename = "*.pdf" 'aranacak dosya isimleri/uzantıları
If .Execute() > 0 Then
'MsgBox .FoundFiles.Count & " adet dosya bulundu."
For i = 1 To .FoundFiles.Count
OutMail.Attachments.Add .FoundFiles(i)
Next i
Else
MsgBox "Hiç dosya bulunamadı.", vbCritical
End If
End With
 
Upvote 0

Forum statistics

Threads
1,214,635
Messages
6,120,660
Members
448,975
Latest member
sweeberry

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top