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
 

Excel Facts

Excel motto
Not everything I do at work revolves around Excel. Only the fun parts.
Hi vendetta,

Here is a function (FindFiles) that searches the specified folder (and sub-folders if required) for the specified file spec and returns an array of files as well as the number of found files. You can find detailed explanation on how to use the function in the beginning of the code
Code:
[FONT="Consolas"][SIZE="2"][COLOR="Navy"]Option Explicit

Function FindFiles(ByVal sPath As String, _
    ByRef sFoundFiles() As String, _
    ByRef iFilesFound As Integer, _
    Optional ByVal sFileSpec As String = "*.*", _
    Optional ByVal blIncludeSubFolders As Boolean = False) As Boolean
[COLOR="Green"]'
' FindFiles
' ---------
' Find all files matching the specified file spec, starting from the specified path
' and search subfolder as required.
'
' Parameters
' ----------
' sPath (String): Startup folder, e.g. "C:\Users\Username\Documents"
'
' sFoundFiles (String): Two dimensional array to store the path and name of found files.
'   The dimension of this array is (1 To 2, 1 To nnn), where nnn is the number of found
'   files. The elements of the array are:
'      sFoundFiles(1, xxx) = File path     (xxx = 1 to nnn)
'      sFoundFiles(2, xxx) = 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
'   sFoundFiles = Array of paths and names of all found files
'   iFilesFound = Number of found files
' False: No files found, therefore
'   iFilesFound = 0
'
' **********************************  Important Note  **********************************
'
' When searching for *.xls, FindFiles returns, in addition to xls files, xls* (not xls?)
' files (e.g. xlsX, xlsM, xlsWhatever, etc.). The reason is that FindFiles uses the Dir
' function and these files are returned by Dir! The most interesting thing here is that
' Windows search (including DOS DIR command) returns the same! It seems Excel Dir uses
' Windows search without any further checking or refinements.
'
' This is also true for *.doc and *.ppt files. Actually, this is true whenever a
' three-character file extension is specified; *.txt, *.pdf, *.x?s, etc.
'
' Moreover, if the last character of the specified extension was a question mark (?) or
' an asterisk (*), the returned files would be the same (e.g. *.txt? and *.txt* return
' the same files). This means, files with more than four-character extension are returned
' in both cases. This is exactly the same behaviour when specifying three-character
' extension (*.txt)…so weird!
'
' The aforementioned behaviour was observed in Windows 7 using Excel 2010 (mostly, Excel
' is not a key player here).
'
' Not everything is covered in this note as further tests might reveal more. So, keep
' these things in mind when using Dir or FindFile.
'
' Constructive comments and Reporting of bugs would be appreciated.
'
' **************************************************************************************
'
' Using the function (sample code)
' --------------------------------
' Dim iFilesNum As Integer
' Dim iCount As Integer
' Dim sMyFiles() As String
' Dim blFilesFound As Boolean
'
' blFilesFound = FindFiles("C:\Users\Username\Documents", _
'     sMyFiles, iFilesNum, "*.xls", True)
' If blFilesFound Then
'     For iCount = 1 To iFilesNum
'         MsgBox "Path: " & sMyFiles(1, iCount) & vbNewLine & _
'             vbNewLine & "File name: " & sMyFiles(2, iCount), _
'             vbInformation, "Files Found"
'     Next
' End If
'[/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

    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)
    Do While sFileName <> ""
        iCount = UBound(sFoundFiles, 2)
        iCount = iCount + 1
        ReDim Preserve sFoundFiles(1 To 2, 1 To iCount)
        sFoundFiles(1, iCount) = sPath
        sFoundFiles(2, iCount) = sFileName
        sFileName = Dir()
    Loop
    If blIncludeSubFolders Then
[COLOR="Green"]        '*
        '* Select next subforbers[/COLOR]
        For Each oFolder In oParentFolder.SubFolders
            FindFiles oFolder.Path, sFoundFiles, iFilesFound, sFileSpec, blIncludeSubFolders
        Next
    End If
    FindFiles = UBound(sFoundFiles, 2) > 0
    iFilesFound = UBound(sFoundFiles, 2)
    On Error GoTo 0
[COLOR="Green"]    '*
    '* Clean-up[/COLOR]
    Set oFolder = Nothing
    Set oParentFolder = Nothing
    Set oFileSystem = Nothing

End Function[/COLOR][/SIZE][/FONT]
 
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]
 
Upvote 0
Dear Mohammad, just a big thank you for this code. It did save me from a nice headache while converting an Excel 2003 macro into Excel 2010...
Best regards
 
Upvote 0
Hi vendetta,

Here is a function (FindFiles) that searches the specified folder (and sub-folders if required) for the specified file spec and returns an array of files as well as the number of found files. You can find detailed explanation on how to use the function in the beginning of the code

I have been searching for a long time for a fast searching function.... considering it is only VBA it is quite fast, It was pointed out on other sites that classes are not as fast as SQL for adding data to a table. I tried both methods, using recordset add from your class, and SQL execute for every file match in the findfiles .. runtime was the same!!! go figure.
Anyway, much appreciated.
VIxnfox
PS I was working on a Movie database and got stuck on a decent search function. I ended up cloning a "copy" of Agent Ransack
https://www.mythicsoft.com/agentransack
which is where your function comes in....
now.... if only I could get those pesky system folder icons into the results,,,,,
 
Last edited:
Upvote 0
I have been searching for a long time for a fast searching function.... considering it is only VBA it is quite fast, It was pointed out on other sites that classes are not as fast as SQL for adding data to a table. I tried both methods, using recordset add from your class, and SQL execute for every file match in the findfiles .. runtime was the same!!! go figure.
Anyway, much appreciated.
VIxnfox
PS I was working on a Movie database and got stuck on a decent search function. I ended up cloning a "copy" of Agent Ransack
https://www.mythicsoft.com/agentransack
which is where your function comes in....
now.... if only I could get those pesky system folder icons into the results,,,,,

grrrrr@10 minute rule....
I used this declaration and modified accordingly
Code:
Option Explicit
'data for file search


Private sName As String
Private sPath As String
Private sSize As Long
Private sType As String
Private sModified As Date
Private sCreated As Date
Private sAccessed As Date


Public Property Get Name() As String
    Name = sName
End Property
Public Property Let Name(value As String)
    sName = value
End Property
Public Property Get Path() As String
    Path = sPath
End Property
Public Property Let Path(value As String)
    sPath = value
End Property
Public Property Get Size() As String
    Size = sSize
End Property
Public Property Let Size(value As String)
    sSize = value
End Property
Public Property Get FType() As String
    FType = sType
End Property
Public Property Let FType(value As String)
    sType = value
End Property
Public Property Get Modified() As Date
    Modified = sModified
End Property
Public Property Let Modified(value As Date)
    sModified = value
End Property
Public Property Get Created() As Date
    Created = sCreated
End Property
Public Property Let Created(value As Date)
    sCreated = value
End Property
Public Property Get Accessed() As Date
    Accessed = sAccessed
End Property
Public Property Let Accessed(value As Date)
    sAccessed = value
End Property
 
Upvote 0
Hello everyone,

If you don't understand what i explain, please ask me again, i'm french so maybe i wont be very clear ^^

Can somebody help me with this new function Mohammad Basem made ?

This is my function :
Code:
With Application.FileSearch
     .NewSearch
     .LookIn = PublicationFolder
     .FileName = "*.xml"
     .SearchSubFolders = True
     .Execute
       For i = 1 To .FoundFiles.Count
          ' Application.Cursor = xlWait
           Range("A" & IndLigne) = .FoundFiles(i)
           Range("B" & IndLigne) = FileLen(.FoundFiles(i))
           OkP = MarquerLesFichiersADetruire(Range("A" & IndLigne), PatternList, IndLigne)
           IndLigne = IndLigne + 2
           Application.Cursor = xlDefault
           NbFichiers = NbFichiers + OkP
       Next i
End With

This is what i tried :
Code:
blFilesFound = FindFiles(PublicationFolder, recMyFiles, iFilesNum, PatternList, True)

If blFilesFound Then
    For iCount = 1 To iFilesNum
        With recMyFiles(iCount)
            ' Application.Cursor = xlWait
             Range("A" & IndLigne) = .FoundFiles(i)
             Range("B" & IndLigne) = FileLen(.FoundFiles(i))
             OkP = MarquerLesFichiersADetruire(Range("A" & IndLigne), PatternList, IndLigne)
             IndLigne = IndLigne + 2
             Application.Cursor = xlDefault
             NbFichiers = NbFichiers + OkP
        End With
    Next
End If

First, I don't know if i do the same thing in both program (i didn't make this program, i just have to update it).
Secondly, I don't really understand what i have to put instead of .FoundFiles which is something of the old function FileSearch...

Does someone have a clue ?


Thanks for your help.
 
Upvote 0

Forum statistics

Threads
1,223,911
Messages
6,175,325
Members
452,635
Latest member
laura12345

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