none
Application.FileSearch in Excel 2007

    Question

  • There is an issue which I am facing after I installed Office 2007.  I had written a small VBA which would search for a file and if found will rename the file.

    I used Application.FileSearch then.  Now I am tying to do it again but unfortunately there is an error prompted stating that 'the object does not exist'

    Set fSearch = Application.FileSearch

    defPath = "H:\SourceSafe_1_Feb-28_Feb_2006\SecondSet"

    Set rg = Range("MyFiles")
    fSearch.LookIn = defPath

    I have been frantically looking for changes in the VBA object model especially for Excel but cant seem to find them.
    Monday, June 05, 2006 9:18 AM

Answers

  • Hi,

    I only have 2003 so this is just advice rather than an absolute answer. In the VBA Editor use the Object Browser and do a search (or browse) for the Application object. See if the FileSearch object is there.

    If that doesn't help can you find a feature on the GUI to do the File Search. If you can record a macro and that will give you an idea of what legacy code to use.

    I hope that helps.

    Monday, June 05, 2006 10:10 AM

All replies

  • Hi,

    I only have 2003 so this is just advice rather than an absolute answer. In the VBA Editor use the Object Browser and do a search (or browse) for the Application object. See if the FileSearch object is there.

    If that doesn't help can you find a feature on the GUI to do the File Search. If you can record a macro and that will give you an idea of what legacy code to use.

    I hope that helps.

    Monday, June 05, 2006 10:10 AM
  • I am having this same problem as well doing a very similar thing but in Excell. The code is as follows

        Set fs = Application.FileSearch
       
        With fs
            'retrieve all .doc files in DB directory
           
            .lookin = [Internal Functions].dirName
            .fileName = "*.doc"
            .Execute
            fC = .foundfiles.Count
            If fC = 0 Then Exit Sub

    etc. etc. Its easy to see what its doing.

    If anyone has a workaround for this or knows whether they replaced this function with a different name please post it! I have looked for hours and been unable to figure out a reciprocal command, nor why they would take it out of the language. Thanks so much!

     

    John

    Monday, June 19, 2006 10:15 PM
  • Hi

    I went back to using VBScript to get the job done

    here is a snippet

    Function ReportFileStatus(filespec)
    Dim fso, msg
    Set fso = CreateObject("Scripting.FileSystemObject")
    If (fso.FileExists(filespec)) Then
    msg = filespec & " exists."
    Else
    msg = filespec & " doesn't exist."
    End If
    ReportFileStatus = msg
    End Function

    this should do the job for you... ofcourse with a bit of modification.
    Make sure that you save the file in XLS format rather than the new XLSX format.

    Glax

    Wednesday, June 21, 2006 7:33 AM
  • Thought I'd just put a quick reply to this as I was having trouble with this file searching process.  I used it in Access and then tried to use it when writing an Outlook macro, with no joy.  I think it is specific to Access, because I managed to change my code as follows and it now works.  Know this post is old, but if anyone has the same problem as us, could save hours of frustration. (You need to add the 'Microsoft Access 9.0 Object Library' to your references).

    Sub processFiles()

    Dim app02 As New Access.Application
    Dim filename
    Dim NumFiles
    NumFiles = 0

    line1:
    With Access.Application.FileSearch
        .NewSearch
        .LookIn = "C:\Temp\Dataprep\"
        .SearchSubFolders = False
        .MatchTextExactly = True
        .filename = "*.*"
        .Execute

    End With


    If FileSearch.FoundFiles.Count > 0 Then
    filename = FileSearch.FoundFiles.Item(1)

    'Put your code that processes files here

    Name filename As Left(filename, 17) & "processed\" & Mid(filename, 18, 60)
    NumFiles = NumFiles + 1
    GoTo line1
    Else

    End If
    MsgBox NumFiles & " File(s) Processed!", vbOKOnly, "Finished!"
    End Sub

    All this code does is loop through the dataprep folder and place all the files it finds in a 'processed' sub folder.

    This is placed in an excel module and seems to do the trick.  I know the code's probably badly written but hope it will be of use to someone.

     

    Friday, August 18, 2006 7:51 AM
  • Have a quick look at my response to the original question. Hope that helps mate.
    Friday, August 18, 2006 7:53 AM
  • Thanks! Brilliant!

     DieZeL wrote:
    Hi

    I went back to using VBScript to get the job done

    here is a snippet

    Function ReportFileStatus(filespec)
    Dim fso, msg
    Set fso = CreateObject("Scripting.FileSystemObject")
    If (fso.FileExists(filespec)) Then
    msg = filespec & " exists."
    Else
    msg = filespec & " doesn't exist."
    End If
    ReportFileStatus = msg
    End Function

    this should do the job for you... ofcourse with a bit of modification.
    Make sure that you save the file in XLS format rather than the new XLSX format.

    Glax

    • Proposed as answer by jamesm1983 Monday, February 09, 2009 8:33 PM
    Saturday, December 23, 2006 1:48 PM
  • [quote user="DieZeL"]
    Function ReportFileStatus(filespec)
    Dim fso, msg
    Set fso = CreateObject("Scripting.FileSystemObject")
    If (fso.FileExists(filespec)) Then
    msg = filespec & " exists."
    Else
    msg = filespec & " doesn't exist."
    End If
    ReportFileStatus = msg
    End Function

    Glax


    Thats great!

    But your function works only to find whether specific file exist or doesn't exist. Is there a way to find whether any files exist in the particular folder. If yes loop through all existing files.

    I need to find all existing files and run some other code. Can u plz help to find all those files...
    Thankyou.
    Tuesday, December 26, 2006 4:59 AM
  • sorry, Dear Danny,

    ".FileSearch."

    it's no more time standard in 2007, SEVEN!

     

     

    Tuesday, December 26, 2006 12:06 PM
  • please look this niceFine link;
    it's the most I like in MSDN

    Scripting Runtime Library

    FileSystemObject Sample Code

    it's a great sample, a little bit too much ragged and cleved logic with procedures, but: all you need!

    or use "CreateObject("Scripting.FileSystemObject")" as searchWord in MicrosoftMSDN

    Tuesday, December 26, 2006 12:21 PM
  • Application.FileSearch has been deprecated from Excel 2007.

    - Jon
    -------
    Jon Peltier, Microsoft Excel MVP
    Tutorials and Custom Solutions
    http://PeltierTech.com
    _______
    
    Tuesday, December 26, 2006 3:39 PM
  • But if you look in help you can see in searching SearchScope this:

    Sub DisplayAvailableScopes()
    
        'Declare a variable that references a
        'SearchScope object.
        Dim ss As SearchScope
    
        'Use a With...End With block to reference the
        'FileSearch object.
        With Application.FileSearch
    
            'Loop through the SearchScopes collection.
            For Each ss In .SearchScopes
                Select Case ss.Type
                    Case msoSearchInMyComputer
                        MsgBox "My Computer is an available search scope."
                    Case msoSearchInMyNetworkPlaces
                        MsgBox "My Network Places is an available search scope."
                    Case msoSearchInOutlook
                        MsgBox "Outlook is an available search scope."
                    Case msoSearchInCustom
                        MsgBox "A custom search scope is available."
                    Case Else
                        MsgBox "Can't determine search scope."
                End Select
            Next ss
        End With
    End Sub
    Filesearch exist or not in Access 2007, what do you think ?????
    Thursday, January 11, 2007 4:10 PM
  • I don't know about Access. I do know .FileSearch is gone from Excel 2007. I also know that there is little practical information available yet on the changes to VBA or the Office 2007 Object Models.

    - Jon
    -------
    Jon Peltier, Microsoft Excel MVP
    Tutorials and Custom Solutions
    http://PeltierTech.com
    _______
    
    Thursday, January 11, 2007 6:27 PM
  • 9 months later, is there any practical information available now?
    Sunday, March 25, 2007 5:05 AM
  • There has been little in the way of KB articles. Have you looked at the online help? That's what I was trying to use in January to explore the object model, but it was not yet mature enough, and using the object browser alone was also not very useful.

    - Jon
    -------
    Jon Peltier, Microsoft Excel MVP
    Tutorials and Custom Solutions
    http://PeltierTech.com
    _______
    Wednesday, March 28, 2007 12:41 AM
  •  Jon Peltier wrote:

    There has been little in the way of KB articles. Have you looked at the online help? That's what I was trying to use in January to explore the object model, but it was not yet mature enough, and using the object browser alone was also not very useful.

    - Jon
    -------
    Jon Peltier, Microsoft Excel MVP
    Tutorials and Custom Solutions
    http://PeltierTech.com
    _______

     

    I have also had problems. is there not a replacement. i use excell for quoting.

    i do a search to count the number of files to auto increment the number in the file name.

    then save the file. This worked fine under 2003.......but that was then.

    any one with an idea for a workaround would be appreciated.

    thanx

     

    Michael

     

    CODE

     


    Private Sub Save_Quote_Click()
    Dim Fname, Dname, nf, hr, response, mystring
    Dim objShell  As Shell
    Dim objFolder As Folder
      

            Range("C10").Select
        
        Dname = GetFolder(CSIDL_PERSONAL) + "\Quotes\"
        Fname = Range("d5")
        ActiveWorkbook.BuiltinDocumentProperties.Item("Comments").Value = Range("System_Comments")
       
    With Application.FileSearch
        .NewSearch
        .LookIn = Dname
        .Filename = Left(Fname, Len(Fname) - 1) + "*.xls"
        .FileType = msoFileTypeExcelWorkbooks

        If .Execute(SortBy:=msoSortByFileName, _
                SortOrder:=msoSortOrderAscending) > 0 Then
           ' MsgBox "There were " & .FoundFiles.Count & _
            " file(s) found."
           
            nf = .FoundFiles.Count
            Fname = Fname & "_" & nf
           

            If Range("New_File") = 0 Then MsgBox "Saving As " & ActiveWorkbook.Name: _
            ActiveWorkbook.Save Else Range("New_File") = 0
            response = MsgBox("Saving As " & Dname & Fname, vbYesNo, "Hare And Now Consulting Inc.")
                If response = vbYes Then    ' User chose Yes.
                    mystring = "Yes"
                Else    ' User chose No.
                    End
                End If

            ActiveWorkbook.SaveAs _
            Filename:=Dname & Fname, _
            FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
            ReadOnlyRecommended:=False, CreateBackup:=False
           
        Else
            Range("New_File") = 0
             response = MsgBox("Saving As " & Dname & Fname, vbYesNo, "Hare And Now Consulting Inc.")
                If response = vbYes Then    ' User chose Yes.
                    mystring = "Yes"    ' Perform some action.
                Else    ' User chose No.
                    End  ' Perform some action.
                End If
            ActiveWorkbook.SaveAs Filename:=Dname & Fname, _
            FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
            ReadOnlyRecommended:=False, CreateBackup:=False
           
        End If
    End With
     Range("C10").Select
     ActiveWorkbook.Saved = True
    End Sub

     

     

    Sunday, April 08, 2007 1:26 AM
  • Anyone have any news about this "feature"????  I just found out about it trying to run one of my macros after installing Office 2007.  Thanks in advance!!!!

     

    Tuesday, September 25, 2007 6:17 PM
  • No news. FileSearch is gone and is going to stay that way.

     

    Earlier in this thread, someone posted a FSO solution, and you can use Dir just as effectively. Look up File System Object or VB File System for guidance.

     

    You might also take a shot at Googling "FileSearch replacement", because some time back I saw a class module someone had posted that essentially mimics the FileSearch functionality.


    - Jon
    -------
    Jon Peltier, Microsoft Excel MVP
    Tutorials and Custom Solutions
    Peltier Technical Services, Inc. - http://PeltierTech.com
    _______

     

    Tuesday, September 25, 2007 7:49 PM
  • Hi!

    I've prepare an example to you (with FSO). This is a recursive function, which returns last found file. It quite simple and you can use this code:

     

    'Procedure to launch
    Sub FileSearch()

     

    Dim sStartPath As String
    Dim sWhat As String
    Dim result As String


    sStartPath = "C:\Archive\" 'Where?
    sWhat = "test.log" 'What?
    result = DigIn(sStartPath, sWhat) 'First step
    MsgBox result

     

    End Sub

     

    Function DigIn(sPath As String, sWhat As String) As String


    Dim fs As New FileSystemObject
    Dim dDirs As Folder
    Dim dDir As Folder
    Dim fFile As File


    Set dDirs = fs.GetFolder(sPath)


    For Each dDir In dDirs.SubFolders
        DigIn = DigIn(dDir.Path, sWhat) ' Here is the recursion
    Next
    For Each fFile In dDirs.Files
        If fFile.ShortName = sWhat Then ' File checking
            DigIn = fFile.Path
            Exit Function ' You can remove that if you don't want to wait for all files
        End If
    Next

     

    End Function

     

    Wednesday, September 26, 2007 7:27 AM
  • Hi,


    I've another, easy to use, solution for the FileSearch replacement, when no recursion is needed.
    I'm using Dir and a Collection to process all the files of one type in a directory.
    It works with Winword, Access an Excel and you can add, rename or delete files in the directory.

     


    Sub File_Search()

     

        Dim Coll_Docs As New Collection
        Dim Search_path, Search_Filter, Search_Fullname as String
        Dim DocName As String

        Dim i as Long

     

        Search_Path = "C:\Testpath"   ' where ?
        Search_Filter = "*.doc"            ' what ?
        Set Coll_Docs = Nothing

     

        DocName = Dir(Search_Path & "\" & Search_Filter)


        Do Until DocName = ""            ' build the collection
            Coll_Docs.Add Item:=DocName
            DocName = Dir
        Loop

     

        MsgBox "There were " & Coll_Docs.Count & " file(s) found."
       
        For i = Coll_Docs.Count To 1 Step -1              '
            Search_Fullname = Search_Path & "\" & Coll_Docs(i)

     

        (your code here)

     

        Next

     

    End Sub
        
        
       
    Jean-Paul

    • Proposed as answer by abSetiawan Tuesday, October 25, 2011 11:04 AM
    Tuesday, November 13, 2007 1:53 PM
  •  

    Recursion is still required if you went to read files in any subdirectories.

    - Jon
    -------
    Jon Peltier, Microsoft Excel MVP
    Tutorials and Custom Solutions
    Peltier Technical Services, Inc. - http://PeltierTech.com
    _______

    Tuesday, November 13, 2007 3:35 PM
  • Hello,

     

    I've found a simple variant (which can avoid "application.filesearch") in the Help file from Access 2007.

    I would like to share it with anyone might be interested.

     

    Sub ShowFolderList (folderspec)

    Dim fs, f, f1, fc, s

    Set fs = CreateObject ("Scripting.FileSystemObject")

    Set f = fs.GetFolder(folderspec)

    Set fc = f.Files

    For Each f1 in fc

    s = s & f1.name

    s = s & vbCrLf

    Next

    MsgBox s

    End Sub

     

    'Just replace "folderspec" with the correct path (like Set f = fs.GetFolder ("C:\My Documents")) and it should run.

     

    Best regards,

    Bogdan

     
    Monday, November 19, 2007 7:42 PM
  • I can't believe what I am reading here.  I just upgraded my machine to Excel 2007 and ran into the same problem discussed in this thread.  Why on earth would Microsoft remove something that people have written into their tools?  I thought one of the guarantees about using Microsoft products for development was that forward compatibility was guaranteed.  Isn't that why we go to so much trouble to write code the way Microsoft wants us to, so we know the code will still work in future versions?  When I think of all the times in the past we got our hands slapped by Microsoft for circumventing their API and breaking in future versions, I'm beginning to wonder, what's the point?  Even if we do follow their prescribed advice, we are still hosed.

     

    We have created several tools at my company that depend on FileSearch; and we have distributed these tools to thousands of people within the company.  Providing us with different ways to accomplish the same task that FileSearch performed for us doesn't help us; we still have to distribute the re-written tool to thousands of people and we don't know who these thousands of people are.  And, because we don't know who these thousands of people are, we are either going to get hit with thousands of Support calls or people will stop using our tools.

     

    The other thing that really concerns me is why the MSDN 2007 help topics still reference FileSearch (as someone else pointed out many months ago in this thread).  Why hasn't someone at Microsoft removed those references?  That caused us much more difficulty because by seeing these references, it never occured to us that FileSearch had been removed.  So, we have spent countless hours trying to debug our code.  Geez, why don't I get a topic saying "FileSearch has been removed" when I search help for FileSearch?

     

    I'm sorry, but this just doesn't make sense to me.  How could Microsoft do this to their customers?  This will certainly delay our upgrades.

    Friday, January 18, 2008 9:39 PM
  •  Mezhick wrote:

    Hi!

    I've prepare an example to you (with FSO). This is a recursive function, which returns last found file. It quite simple and you can use this code:

     

    'Procedure to launch
    Sub FileSearch()

     

    Dim sStartPath As String
    Dim sWhat As String
    Dim result As String


    sStartPath = "C:\Archive\" 'Where?
    sWhat = "test.log" 'What?
    result = DigIn(sStartPath, sWhat) 'First step
    MsgBox result

     

    End Sub

     

    Function DigIn(sPath As String, sWhat As String) As String


    Dim fs As New FileSystemObject
    Dim dDirs As Folder
    Dim dDir As Folder
    Dim fFile As File


    Set dDirs = fs.GetFolder(sPath)


    For Each dDir In dDirs.SubFolders
        DigIn = DigIn(dDir.Path, sWhat) ' Here is the recursion
    Next
    For Each fFile In dDirs.Files
        If fFile.ShortName = sWhat Then ' File checking
            DigIn = fFile.Path
            Exit Function ' You can remove that if you don't want to wait for all files
        End If
    Next

     

    End Function

     

     

    I got this to work with some modifications (currently testing in Excel 2003, do not yet have 2007).

    The compiler didn't like the definition "Dim fs As New FileSystemObject" so I looked up FileSystemObject and found this to be useful http://msdn2.microsoft.com/en-us/library/2z9ffy99.aspx... as it says, you have to have the Scripting library installed (scrrun.dll, or Tools>References>Microsoft Scripting Runtime).  So I changed the definition of the FSO, as highlighted in the code below.

     

    Secondly, I had to change the "fFile.ShortName" if-then statement to "fFile.Name" because "ShortName" was looking for an abbreviated filename that uses the tilde "~"

     

    But thanks for the code... I hope it works when my company forces us to Office 2007  =P

     

    Code Snippet

    Function DigIn(sPath As String, sWhat As String) As String


    Dim fso
    Dim dDirs As folder
    Dim dDir As folder
    Dim fFile As File

     

    Set fso = CreateObject("Scripting.FileSystemObject")

    Set dDirs = fso.GetFolder(sPath)


    'For Each dDir In dDirs.SubFolders
    '    DigIn = DigIn(dDir.Path, sWhat) ' Here is the recursion
    'Next
    For Each fFile In dDirs.Files
        If fFile.Name = sWhat Then ' File checking
            DigIn = fFile.Path
            Exit Function ' You can remove that if you don't want to wait for all files
        End If
    Next

     

    End Function

     

     


    Tuesday, March 04, 2008 8:06 PM
  • This is some code I was able to make work in Excel 2007.  It replaces Application.Filesearch, uses wildcards, and looks in subfolders.  It's not the most sophisticated code, but it gets the job done.  I thought I'd post it since I've been having such a hard time finding examples with all three elements in them.

     

    Dim lst As New Collection

     

    Sub FileSearch()
    Dim sStartPath  As String
    Dim sWhat       As String
    Dim result      As String
    Dim t           As Integer
    Dim tmp         As String

    sStartPath = "C:\archive\" 'Where?
    sWhat = "*.pdf" 'What?

    If lst.Count > 0 Then
        Do
            lst.Remove lst.Count 'clears list if data already exists
        Loop Until lst.Count = 0
    End If
    ThisWorkbook.Sheets(1).Columns(1).ClearContents

    result = DigIn2(sStartPath, sWhat) 'First step
    For t = lst.Count To 1 Step -1
        ThisWorkbook.Sheets(1).Cells(t, 1) = lst(t) 'puts data in 1st sheet, 1st column
        lst.Remove t
    Next t
    Columns("A:A").Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlNo, _
     OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
    End Sub

     

    Function DigIn2(sPath As String, sWhat As String)
       
        Dim fs
        Dim dDirs
        Dim dDir
        Dim fFile
        Dim c       As Variant
        Dim tmp     As String
       
        Set fs = CreateObject("Scripting.FileSystemObject")
        Set dDirs = fs.GetFolder(sPath)
       
        For Each dDir In dDirs.SubFolders
            tmp = DigIn2(dDir.Path, sWhat)
        Next
        tmp = Dir(dDirs.Path & "\" & sWhat)
        If tmp <> "" Then
            Do
                lst.Add dDirs.Path & "\" & tmp
                tmp = Dir
            Loop Until tmp = ""
            Exit Function
        End If
    End Function

     

    Monday, April 21, 2008 7:59 PM
  • i'm pretty pissed microsoft put the Application.FileSearch out....

    now i don't know what to do..

     

    sombody know how to make this script work in office 2007 ?

     

     

    Dim i As Long
        With Application.FileSearch
            .NewSearch
            .LookIn = NewTemplatePath
            .SearchSubFolders = False
            .FileType = msoFileTypeAllFiles
            If .Execute > 1 Then
                If .FoundFiles.Count = 0 Then
                    MsgBox "Error - Er zijn geen .dot bestanden gevonden.", vbCritical
                    Exit Sub
                End If
                For i = 1 To .FoundFiles.Count
                    If Right(.FoundFiles(i), 3) = "dot" Then
                        Call Me.cboTemplates.AddItem(FileNameOnly(.FoundFiles(i)))
                    End If
                Next i
            End If
        End With

    Tuesday, April 22, 2008 9:12 AM
  • Try something like this.

     

    'Dim i As Long

    Dim tmp
    '    With Application.FileSearch
    '        .NewSearch
    '        .LookIn = NewTemplatePath

     

    tmp = Dir(NewTemplatePath & "*.*")


    '        .SearchSubFolders = False
    '        .FileType = msoFileTypeAllFiles
    '        If .Execute > 1 Then

    '            If .FoundFiles.Count = 0 Then

     

                If tmp = "" then
                    MsgBox "Error - Er zijn geen .dot bestanden gevonden.", vbCritical
                    Exit Sub
                End If


    '            For i = 1 To .FoundFiles.Count

     

    Do
    '                If Right(.FoundFiles(i), 3) = "dot" Then

     

                    If Right(tmp, 3) = "dot" then
                        Call Me.cboTemplates.AddItem(FileNameOnly(tmp))
                    End If


    '            Next i

     

    Loop Until tmp = ""
    '        End If
    '    End With

    Tuesday, April 22, 2008 12:28 PM
  •  memig wrote:

    Try something like this.

     

    'Dim i As Long

    Dim tmp
    '    With Application.FileSearch
    '        .NewSearch
    '        .LookIn = NewTemplatePath

     

    tmp = Dir(NewTemplatePath & "*.*")


    '        .SearchSubFolders = False
    '        .FileType = msoFileTypeAllFiles
    '        If .Execute > 1 Then

    '            If .FoundFiles.Count = 0 Then

     

                If tmp = "" then
                    MsgBox "Error - Er zijn geen .dot bestanden gevonden.", vbCritical
                    Exit Sub
                End If


    '            For i = 1 To .FoundFiles.Count

     

    Do
    '                If Right(.FoundFiles(i), 3) = "dot" Then

     

                    If Right(tmp, 3) = "dot" then
                        Call Me.cboTemplates.AddItem(FileNameOnly(tmp))
                    End If


    '            Next i

     

    Loop Until tmp = ""
    '        End If
    '    End With

     

    well it seems to work..but when i execute the script it stays in a continuous loop and nothing will respond..

     

    any suggestions?

    Wednesday, April 23, 2008 6:59 AM


  • I appologize!  Before Loop Until tmp = "" there should be a line that states tmp = Dir.  Try that and see if it works.
    Thursday, May 01, 2008 4:55 PM
  • You folks have posted several Excel 2007 compatible (I think) code snippets that collect file names and dive into sub-directories.

     

    I'm not following all of this very well....

     

    I have a need to process all files found within a specific directory that I supply to the sub, here's my code below (minus the processing part).

     

    Any specific suggestions for alternatives in this code for  "FileSearch" ???

     

        
        
    With Application.FileSearch
            .NewSearch
            .LookIn = FilePath
            .Filename = "*.txt"
            .SearchSubFolders = False
            .Execute
            
            For i = 1 To .FoundFiles.Count
                 
                InFile = .FoundFiles(i)
                             
                Workbooks.Open Filename:=.FoundFiles(i)

    ' do things with this file

     

    Next i

     

    End With

     

    Tuesday, May 20, 2008 3:18 PM
  • Found the following which provides a workaround and sample code...

     

    Microsoft Help and Support

    Tuesday, June 10, 2008 6:54 PM
  • here is a modified version of jpschmit

     

    replacement for application.filesearch.foundfiles Excel 2007

     

    Sub test()
    Dim Coll_Docs As New Collection
    Set Coll_Docs = Nothing
    File_Search "filepath", "filename", Coll_Docs

      MsgBox "There were " & Coll_Docs.Count & " file(s) found."
       
        For i = Coll_Docs.Count To 1 Step -1              '
          
            MsgBox Coll_Docs(i)
     
        Next

    End Sub


    Sub File_Search(rootpath As String, filename As String, ByVal Coll_Docs As Collection)
        Dim DocName As String
        Dim i As Long
        Dim Search_Filter As String
        Search_Filter = "*.*"
       
       DocName = Dir(rootpath & "\" & Search_Filter)
      
        Do Until DocName = ""
         If DocName = filename Then
                Coll_Docs.Add Item:=rootpath + "\" + DocName   //this shows the full path for the doc
         End If
         DocName = Dir
        Loop

       
        Dim fs, f, s
         Set fs = CreateObject("Scripting.FileSystemObject")
         Set f = fs.GetFolder(rootpath)

        Dim subfolder
        Dim rootpathx As String
        Set subfolder = f.subfolders
        For Each f1 In subfolder
            rootpathx = rootpath & "\" & f1.Name
                File_Search rootpathx, filename, ByVal Coll_Docs
              
            Next
    End Sub

     

    Tuesday, July 22, 2008 6:57 PM
  • I had the same problem with an Application which uses Excel as a front-end when moving from Excel 2003 to 2007. Here is the rewrite of my code which I solved it with.

     

    Public Function SearchFiles(ByVal vsSrcDir As String, ByVal vsSrchFile As String, _
                            rasFileList() As String) As Integer
    ' This function searches for a file or files (if wildcards are used)
    ' in a source directory. The filename and source directory
    ' are passed as parameters. A list of files found are returned in an array,
    ' with a flag indicating whether files were found.
    ' Returns:
    ' 1) 0 if no files
    ' 2) 1 if files found
    ' 3) 2 if error occurred


    ' Declare local variables
    Dim oFileS As Object
    Dim oFldr As Object
    Dim oFileColl As Object
    Dim oFile As Object

    On Error GoTo errorhandler5
              
        Set oFileS = CreateObject("Scripting.FileSystemObject")
        Set oFldr = oFileS.GetFolder(vsSrcDir)
        Set oFileColl = oFldr.Files
        SearchFiles = 0
        nI = -1
        For Each oFile In oFileColl
            If UCase(oFile.Name) Like UCase(vsSrchFile) Then
                    nI = nI + 1
                    ReDim Preserve rasFileList(nI)
                    rasFileList(nI) = vsSrcDir + UCase(oFile.Name)
                    SearchFiles = 1
            End If
        Next
              
        Set oFileS = Nothing
        Set oFldr = Nothing
        Set oFileColl = Nothing
        Set oFile = Nothing
              
    Exit Function

    errorhandler5:
        SearchFiles = 2
        MsgBox "Function FileAccess.SearchFiles: " & Err.Number & vbTab & Err.Description
    End Function

     

    Regards.

     

    Jeggels

     

    Friday, September 12, 2008 2:16 PM
  • I know nothing about macros. Are there any replys that would work with this macro? All replys appreciated.

     

     

     

     

    Public Const DrawSheet = "ALLSTATESDRAWS"
    Public Const AdminSheet = "Admin"
    Public Const SourceDirectory = "c4"

    Dim i, f, xPath, ThisFile, lr, xDate, xNum, LastCol, LastRow, findRow, FindCol, rng, xFile
    Sub SearchFiles()

    Sheets(DrawSheet).Select
    answer = MsgBox("Clear existing data from ALLSTATESDRAWS Page?", vbYesNo, "Clear exsiting database?")
    If answer = vbYes Then Cells.Clear

    LastRow = Range("a65536").End(xlUp).Row
    If LastRow < 5 Then LastRow = 5
    LastCol = Range("iv1").End(xlToLeft).Column
    If LastCol < 2 Then LastCol = 2

    'file path
    If Right(Sheets(AdminSheet).Range(SourceDirectory), 1) <> "\" Then Sheets(AdminSheet).Range(SourceDirectory) = Sheets(AdminSheet).Range(SourceDirectory) & "\"
    xPath = Sheets(AdminSheet).Range(SourceDirectory)

    'find all .xls files
    With Application.FileSearch
        .NewSearch
        .LookIn = xPath
        .Filename = "*.xls"
        .FileType = msoFileTypeAllFiles
        .Execute
    End With
    With Application.FileSearch
       
        For i = 1 To .FoundFiles.Count
            f = .FoundFiles(i)
            If Right(f, 3) = "xls" Then
                If CBool(Len(Dir(f))) = True Then GetData
                End If
        Next i
    End With

    Beep

    'sort database
    Sheets(DrawSheet).Select
    LastRow = Range("a65536").End(xlUp).Row
    LastCol = Range("iv1").End(xlToLeft).Column
    rng = "a6:" & Cells(LastRow, LastCol).Address
    Worksheets(DrawSheet).Range(rng).Sort _
            Key1:=Worksheets(DrawSheet).Range("A1")
            'Key2:=Worksheets("Sheet1").Range("B1")

    Beep

    End Sub

    Sub GetData()

    ThisFile = ActiveWorkbook.Name

    Workbooks.Open Filename:=f
    'find filename
    xFile = Replace(ActiveWorkbook.Name, ".xls", "")


    'find last row
    lr = Range("a65536").End(xlUp).Row
    For r = 2 To lr
        xDate = Range("a" & r)
       
        If Val(xDate) > 0 Then
       
        xNum = Range("b" & r) & Range("c" & r) & Range("d" & r)
       
        'find matching row
        rng = "a1:a" & LastRow
        findRow = 0
        findRow = Application.WorksheetFunction.CountIf(Workbooks(ThisFile).Sheets(DrawSheet).Range(rng), xDate)
        If findRow > 0 Then
            xDate = DateValue(xDate) * 1
          
            findRow = Application.WorksheetFunction.Match(xDate, Workbooks(ThisFile).Sheets(DrawSheet).Range(rng), 0)
            Else
            LastRow = LastRow + 1
            findRow = LastRow
            Workbooks(ThisFile).Sheets(DrawSheet).Cells(findRow, 1) = xDate
            End If
       
        'find matching column
        rng = "a1:" & Cells(1, LastCol).Address
        FindCol = 0
        FindCol = Application.WorksheetFunction.CountIf(Workbooks(ThisFile).Sheets(DrawSheet).Range(rng), xFile)
        If FindCol > 0 Then
           
            FindCol = Application.WorksheetFunction.Match(xFile, Workbooks(ThisFile).Sheets(DrawSheet).Range(rng), 0)
            Else
            LastCol = LastCol + 1
            FindCol = LastCol
            Workbooks(ThisFile).Sheets(DrawSheet).Cells(1, FindCol) = xFile
            End If
           
        'dump data to cell at row/column co-ordinates
        Workbooks(ThisFile).Sheets(DrawSheet).Cells(findRow, FindCol) = xNum
       
        End If
       
        Next r
        
    ActiveWorkbook.Close

     

    End Sub

     

     

    Tuesday, November 18, 2008 7:23 PM
  • ok, this thread has been going for a while and no one has visited for some time. When I noticed that FileSearch was missing after I updated to Office 2007, I decided to recreate the class and save it as a file to import anytime I needed to use it. I tried to use as little code as possible, so if there is some property you would need to add then you may have to add it your self, but this will at least give you most of the funcitonality of the original Class without having to update your existing code too much. You have to just referenct the class and then it can still be used in a with block or however you are accustomed. Here are the two class files that I have, the first I named FileSearch (go figure):


    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


    That should do it.

    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

    so it works exactly the same. The only difference I know of is, if the file you're looking for may have any extension use "*"  instead of "*.*" as microsoft put out. I was lazy and just did a like comparison instead of breaking out the file extensions. All others should theoretically work fine i.e. "*.xls" or "*.txt"

    That's it. Enjoy!!!!!!!!


    James

    • Proposed as answer by GrandPapaZoum Tuesday, November 10, 2009 3:32 PM
    Monday, February 09, 2009 8:33 PM
  • Hi AT T IT,

    I sympathise with you. Here a design suggestion that can protect your future development from tier party stupidity. I have done in the past a solution that works a follows;

    On all the user computers, I have made a Addin that checks in a supporting file (read only) on the network the type of user. This verification uses the user name in the Excel application. After this verification is done, the user identify is assigned to a given group for which the addin automaticaly uninstall/install a set of addins specific to the user group. The other addins contain specific tools that the user might need for their work and are found in a read-only folder on the network.

    When I needed to update the addins on all computers, I just had to make a new version of the addin in question and set the update to due date in the user account file to now for this addin.

    You can push a script too... when the user session starts then the script install the new addin. If your users to not share the same network... send by email a installation .cab containing the required installation files.

    JR
    Thursday, February 26, 2009 8:04 PM
  • Mezhick,

    Your recursion is nice, but you forgot to check your return for a variable before overwriting. I have highlighted my code below.

    Skip

     

    Function DigIn(sPath As String, sWhat As String) As String


    Dim fs As New FileSystemObject
    Dim dDirs As Folder
    Dim dDir As Folder
    Dim fFile As File


    Set dDirs = fs.GetFolder(sPath)


    For Each dDir In dDirs.SubFolders
        DigIn = DigIn(dDir.Path, sWhat) ' Here is the recursion
        ' This will allow the function to return a value once it finds the file - smcherniss
        If DigIn Is Not Empty Then 
            Exit Function
        End If

    Next
    For Each fFile In dDirs.Files
        If fFile.ShortName = sWhat Then ' File checking
            DigIn = fFile.Path
            Exit Function ' You can remove that if you don't want to wait for all files
        End If
    Next

     

    End Function

    Monday, March 09, 2009 4:53 PM
  • This is great.  Im doing an exact thing just with csv files.
    Wednesday, March 18, 2009 8:59 PM
  • I hope everyone can imagin how much damage that responsible has made, who made the descision to eliminate the
    Application.FileSearch object from VBA, from Excel? At least we have a big problem now.

    In short: It is a shame what ever the genius replacment for Application.FileSearch is, how ever genial it is this replacement.
    I call it a very stupid descision to take it out.

    When you seek in Google for Application.FileSerach then you can find more then 11'000 entries for Application.FileSearch. Maybe daily more. 

    And I think there are more then 11'000 peoples now having one or the other problem in one or the other way.

    Lets assume that every 10th engineer writes something Google can find, that would mean, that about 100'000 peopels having problems.

    To assess the situation, a problem solfer and developers group has to assess the varying situations and find a solution for the cause. Then Work has to be performed, all over design and implementation up to deployment. Can you imagin how many hours will be spent for this to be fixed?

    Given over all, I guess, there are more then 100'000 enginers spending 10 hours each, but I guess its about 50 to 100 hours to cure the problem where ever it exists, then we talk about 1 Million to 10 Milliom hours of work! OK? 

    Then multiply this 10 Million work hours by the hourly rate of your company and you have the damage caused by the stupid descision to take Application.FileSearch away from Excel. It can sum up easy to 100 Million up to 1000 Million $ or €.

    If every human knows how to use a hammer.OK, then is enforced by an organizuation to us a stone to hit the nails.
    Can you imagin the damage caused world wide?

    I wonder if someone, hopefully from Microsft can come up with a very good official explanation to tell us at least what has lead to the stupid descision to remove Application.FileSerach from Excel. Maybe we can learn something, maybe not. In any case we all have to fix all our Macros and who pays us to do that?

    And if you look about how many used function has been taken out, then the damage is much higher.
    Monday, April 20, 2009 12:33 PM
  • stadelma I completely agree with what you are saying, this is unbelievable to me.  I work in a very small I.T. shop and have inherited a vb Excel program that we update every year for the next year's use (it is used for budgeting).  Last year in Excel 2003 I was able to figure out all the vb I needed, as I just needed to make tweaks, yet this year with this new 'missing' feature, I am stumped.  You see, I am not a techie programmer type, but yet I have a bit of an aptitude, and we don't have any programmers on staff in our tiny little i.t. shop, and with the current state of the economy we are not able to procure a programmer for this, and it is a small job for an experienced programmer anyway, at least with our one program.  So I think I have figured out that this is a way for Microsoft to generate more revenue, because when I went to contact their support, I was met with a web page describing the $99 one time question fee!  I guess I'll have to fork that over, well the ailing company I work for will...  This is the 'Bill Gates Tax'.
    Thursday, May 14, 2009 9:19 PM
  • '!!!!!!!!!! Replacement solution including searching in subdirectories !!!!!!!!!!!!!!!!!


    //------------------------------------------------------------------------------------------------

    Sub FileSearchByHavrda_Example_of_procedure_calling()
    '
    ' 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)
    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

    //------------------------------------------------------------------------------------------------

    Wednesday, June 24, 2009 2:01 PM
  • '!!!! Replacement solution including searching in subdirectories !!!


    //------------------------------------------------------------------------------------------------

    Sub FileSearchByHavrda_Example_of_procedure_calling()
    '
    ' 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)
    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

    //------------------------------------------------------------------------------------------------

    • Proposed as answer by VBA GURU Friday, June 26, 2009 3:47 AM
    Wednesday, June 24, 2009 5:15 PM
  • Let's not forget that Microsoft's main concern as a business is making "great money" (peddling software), not "great software", otherwise they'd be another Apple... 

    Its o.k to depreciate things - that's progress.  But to leave everyone clueless as to what's going on and what the replacement is for the lost functionality is irresponsible and incompetent.

    I still remember when lots of developers adopted VB 6.0 hook, line, and sinker - it became their very reason for existence - with the idea that things would only improve.  Then Microsoft trashed it all to throw together .Net so it would look like they weren't caught flat-footed by the internet revolution (they were - which is why so many other technologies forged internet development - with Microsoft conspicuously absent.)  Many developers felt betrayed.  Some pledged to NEVER leave 6.0 while many others jumped ship altogether to go to Java.

    The moral of the story is - don't fall in love with any MS technologies - they have a habit of trashing them for something "completely different" (read that as "creating the need to buy again").

    By the way, I noticed that MS was using the term "innovation" a lot in its 2007 product marketing materials.  I thought this was great and long over due until someone inside Redmond told me about the joke going around that "innovation" was the new p.c. term for "oops, we screwed that up!"

    Now there's a news tidbit that makes sense! :)

    By the way... I used the solution proposed in the previous post and, after slight modification for my particular needs, IT WORKED LIKE A CHARM!!!!!!  Nice going, PaHabr!
    • Edited by VBA GURU Friday, June 26, 2009 5:02 AM
    Friday, June 26, 2009 4:07 AM
  • Thank you so much P. Havrda!  This worked perfectly with no modification required.
    Wednesday, July 01, 2009 12:13 AM
  • The default SearchSubFolders = False, put .SearchSubFolders = True and it will works fine:

                With Application.FileSearch
                    .SearchSubFolders = True
    • Proposed as answer by llutz Thursday, August 20, 2009 2:52 PM
    Monday, August 03, 2009 1:22 PM
  • Hi Everyone, you have been so helpful so let me ask if you have a solution to my particular VB Application.FileSearch issue... thanks for all replies! 

    Sub GetAllPendingFiles()

        Sheets("Sales Board").Select
        Range("A2").Select

    With Application.FileSearch
        .NewSearch
        .LookIn = "\\MAXIMUS\CorpSale\Pending Final"  '<== set the directory
        .SearchSubFolders = False
        .Filename = "*.xls"
        .MatchTextExactly = True
        .FileType = msoFileTypeExcelWorkbooks
        If .Execute() > 0 Then
            MsgBox "There were " & .FoundFiles.Count & _
                " file(s) found."
            For i = 1 To .FoundFiles.Count
                Set wkbk = Workbooks.Open(Filename:=.FoundFiles(i), UpdateLinks:=0)
                  wkbk.ActiveSheet.Copy _
                  after:=ThisWorkbook.Sheets(1)
                wkbk.Close savechanges:=False
               
            Range("A2:CU2").Select
            Selection.Copy
            Sheets("Sales Board").Select
            ActiveCell.Select
            ActiveSheet.Paste Link:=True
            ActiveCell.Offset(1, 0).Range("A1").Select
                       
            Next i
        Else
            MsgBox "There were no files found."
        End If
    End With
     
        Range("A2").Select
        MsgBox "Task completed - 1. Select All Data except Date   2.PRESS F5,THEN CLICK 'SPECIAL'   3.CLICK 'VISIBLE CELLS ONLY'    4.CLICK 'COPY'    5. 'PASTE SPECIAL' AS 'VALUES' INTO THIS FILE: \\WARHORSE\INETPUB\INTRANET\SALES\SALESBOARDWEB   5. SAVE 'SALESBOARDWEB' AND EXIT"
     
     
    End Sub

     

     

    Thursday, August 20, 2009 2:56 PM
  • ok, this thread has been going for a while and no one has visited for some time. When I noticed that FileSearch was missing after I updated to Office 2007, I decided to recreate the class and save it as a file to import anytime I needed to use it. I tried to use as little code as possible, so if there is some property you would need to add then you may have to add it your self, but this will at least give you most of the funcitonality of the original Class without having to update your existing code too much. You have to just referenct the class and then it can still be used in a with block or however you are accustomed. Here are the two class files that I have, the first I named FileSearch (go figure):


    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


    That should do it.

    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

    so it works exactly the same. The only difference I know of is, if the file you're looking for may have any extension use "*"  instead of "*.*" as microsoft put out. I was lazy and just did a like comparison instead of breaking out the file extensions. All others should theoretically work fine i.e. "*.xls" or "*.txt"

    That's it. Enjoy!!!!!!!!


    James


    Simply brilliant!

    I gave up searching MSDN for an answer to the vanishing of Filesearch from VBA.

    I came across this thread as the top result in a Google search. Maybe I do not know how to search MSDN but I rarely if ever have any success. 

    I rely more and more to Google's amazing searching capability.

    Thanks for your contribution and Bravo!

    Germain
    Tuesday, November 10, 2009 3:40 PM
  • Thaks Jean-Paul, this worked great!
    Sunday, January 17, 2010 6:54 PM
  • for anyone that cares, I have written a working replacement for FileSearch for Excel 2007. It works almost exeactly the same way, with a few things added. if anyone has suggestions for further additions, let me know.

    One thing to note is that you must check the box labeled "Trust access to the VBA project object model" under "Excel Options\Trust Center\Trust Center Settings\Macro Settings" for the auto-referencing to work, or else you must manually add a reference to "Microsoft Scripting Runtime" to your project.

    Insert a class module into your project and name it "FileSearch2007", then paste in the following code:

    Option Explicit
    
    'Andy Janish 5-26-2010
    '
    'This class is to be used as a replacement for the "Application.FileSearch" method
    'available in Excel 2003 that was deprecated in Excel 2007
    '
    'Properties:
    '1. Filename - filename (with wildcards) to search for (not including directory)
    '2. LookIn - parent directory to search through
    '3. SearchSubFolders - true means to search through any subfolders found
    '4. Sort - true = sort files alphabetically (only applies if subfolders were searched)
    '5. FoundFiles - list of files found in the search
    '6. FilePaths - list of files with full path included found in search
    '7. FileCount - count of the number of files found in the search (UBound(array))
    '
    'Methods:
    '1. NewSearch - clear all previous properties
    '2. Script_Ref - create reference to Microsoft Scripting Runtime dll
    '3. Search_Sub(curFolder As Folder) - searches through all subfolders of the specified folder
    '4. Sort_Files - sorts files alphabetically
    'Functions
    '1. Execute - run the search for the files
    
    'Declare all property variables private
    Private pFileName As String
      'Private pFileType As Integer
    Private pLookIn As String
    Private pSearchSubFolders As Boolean
    Private pSort As Boolean
    Private pFoundFiles() As String
    Private pFilePaths() As String
    Private pFileCount As Integer
    
    
    'Create methods for accessing and modifying all properties
    Public Property Let FileName(Value As String)
      pFileName = Value
    End Property
    
    Public Property Let LookIn(Value As String)
      pLookIn = Value
    End Property
    
    Public Property Let SearchSubFolders(Value As Boolean)
      pSearchSubFolders = Value
    End Property
    
    Public Property Let Sort(Value As Boolean)
      pSort = Value
    End Property
    
    Public Property Get FoundFiles(Value As Integer)
      If (Value < pFileCount And Value >= 0) Then
        FoundFiles = pFoundFiles(Value)
      Else
        MsgBox "Error - File index is too high. Only " & pFileCount & " files were found."
        FoundFiles = ""
      End If
    End Property
    
    Public Property Get FilePaths(Value As Integer)
      If (Value < pFileCount And Value >= 0) Then
        FilePaths = pFilePaths(Value)
      Else
        MsgBox "Error - File index is too high. Only " & pFileCount & " files were found."
        FilePaths = ""
      End If
    End Property
    
    Public Property Get FileCount() As Integer
      FileCount = pFileCount
    End Property
    
    
    
    Public Sub NewSearch()
    'clear any parameters from previous searches
      pFileName = ""
      pLookIn = ""
      pSearchSubFolders = False
      pSort = False
      Erase pFoundFiles
      Erase pFilePaths
      pFileCount = 0
    End Sub
    
    Public Function Execute() As Integer
      Dim n As Integer
      Dim InitDir As String
      Dim tempFile As String
    
      On Error GoTo Execute_Error
      
      'make sure a directory to search was specified
      'and that something is entered for a filename
      If pLookIn = "" Then
        MsgBox "Please specify a directory to search"
      ElseIf pFileName = "" Then
        pFileName = "*"
      End If
      
      'clear any previously found files
      Erase pFoundFiles
      Erase pFilePaths
      pFileCount = 0
      
      'save the initial directory and switch to the search drive\directory
      InitDir = CurDir
      If Mid(pFileName, 2, 1) = ":" Then
        ChDrive Left(pFileName, 2)
      End If
      ChDir pLookIn
      
      'search through the main directory for files matching the filename specified
      tempFile = Dir(pFileName)
      Do While tempFile <> ""
        pFileCount = pFileCount + 1
        ReDim Preserve pFoundFiles(pFileCount)
        ReDim Preserve pFilePaths(pFileCount)
        pFoundFiles(pFileCount - 1) = tempFile
        pFilePaths(pFileCount - 1) = CurDir
        If Right(CurDir, 1) <> "\" Then pFilePaths(pFileCount - 1) = CurDir & "\"
        pFilePaths(pFileCount - 1) = pFilePaths(pFileCount - 1) & tempFile
        tempFile = Dir
      Loop
      
      If pSearchSubFolders Then
        'create reference to "Microsoft Scripting Runtime"
        Call Script_Ref
        
        Dim FS As New FileSystemObject
        Dim FSfolder As Folder
        Set FSfolder = FS.GetFolder(pLookIn)
        
        Call Search_Sub(FSfolder)
        If pSort Then Call Sort_Files
      End If
      ChDrive Left(InitDir, 2)
      ChDir InitDir
      Execute = 1
      Exit Function
      
    Execute_Error:
      MsgBox "Error encountered while searching for files"
      Erase pFoundFiles
      Erase pFilePaths
      pFileCount = 0
      ChDrive Left(InitDir, 2)
      ChDir InitDir
      Execute = 0
    End Function
    
    Private Sub Script_Ref()
      Dim myWkbk As String
      
      On Error Resume Next
      myWkbk = ThisWorkbook.Name
      With Application.Workbooks(myWkbk).VBProject.References
        .AddFromFile "C:\windows\system32\scrrun.dll"
      End With
    End Sub
    
    Private Sub Search_Sub(curFolder As Folder)
      Dim FS As New FileSystemObject
      Dim FSfolder As Folder
      Dim subfolder As Folder
      Dim tempFile As String
      
      'Search the subfolder that was specified,
      'along with any subfolders inside of it
      Set FSfolder = FS.GetFolder(curFolder)
      For Each subfolder In FSfolder.SubFolders
        ChDir subfolder
        tempFile = Dir(pFileName)
        Do While tempFile <> ""
          pFileCount = pFileCount + 1
          ReDim Preserve pFoundFiles(pFileCount)
          ReDim Preserve pFilePaths(pFileCount)
          pFoundFiles(pFileCount - 1) = tempFile
          pFilePaths(pFileCount - 1) = CurDir
          If Right(CurDir, 1) <> "\" Then pFilePaths(pFileCount - 1) = CurDir & "\"
          pFilePaths(pFileCount - 1) = pFilePaths(pFileCount - 1) & tempFile
          tempFile = Dir
        Loop
        'check inside of each subfolder for more subfolders
        'by calling this subroutine recursively
        Call Search_Sub(subfolder)
      Next subfolder
      
      Set FSfolder = Nothing
      Set subfolder = Nothing
    End Sub
    
    Private Sub Sort_Files()
      Dim n As Integer
      Dim m As Integer
      Dim temp As String
      
      'Sort all files found (including those from subfolders) alphabetically
      For n = 0 To (pFileCount - 1)
        For m = n To (pFileCount - 1)
          If (UCase(pFoundFiles(m)) < UCase(pFoundFiles(n))) Then
            temp = pFoundFiles(n)
            pFoundFiles(n) = pFoundFiles(m)
            pFoundFiles(m) = temp
            temp = pFilePaths(n)
            pFilePaths(n) = pFilePaths(m)
            pFilePaths(m) = temp
          End If
        Next m
      Next n
    End Sub
    

    This should now work just like the original FileSearch. To have this available all the time, make sure the class module above was added to your Personal.xls workbook that loads when Excel starts.

    Here's an example of how to use this (the following code should be added to a regular module in your project):

    Sub TestFileSearch()
      Dim n As Integer
      Dim Search As FileSearch2007
      Set Search = New FileSearch2007
    
      With Search
        .NewSearch
        .FileName = "*.xls"
        .LookIn = "C:\"
        .SearchSubFolders = True
        .Sort = True
        If .Execute > 0 Then
          Columns("A:B").ClearContents
          Range("a1").Value = .FileCount
          For n = 1 To .FileCount
            Range("a" & n + 2).Value = .FoundFiles(n - 1)
            Range("b" & n + 2).Value = .FilePaths(n - 1)
          Next n
        End If
      End With
    End Sub
    

    Enjoy! 

    Thursday, May 27, 2010 3:38 PM
  • @janish89

     

    I've get an error here:

    with the Error "Variable not defined" and ThisWorkbook marked. This error popup only if i set .SearchSubFolders to True

    Any thoughts?

    Private Sub Script_Ref()
    Dim myWkbk As String

    On Error Resume Next
    myWkbk = ThisWorkbook.Name
    With Application.Workbooks(myWkbk).VBProject.References
    .AddFromFile "C:\windows\system32\scrrun.dll"
    End With
    End Sub
    Wednesday, June 02, 2010 12:49 PM
  • if you are having issues with the Script_Ref subroutine, you can just manually add the reference rather than playing with the code. Go to Tools/References and check the box next to "Microsoft Scripting Runtime", then remore the whole Script_Ref subroutine from your code. Let me know if the FileSearch2007 code works after that.

    Wednesday, June 09, 2010 1:54 PM
  • Hi I am a complete newby to VBA who has been stranded with this code and I am recieving the same error as all the other 
    postees. 
    I have tried to implement the changes that have been suggested but am afraid that I have been unsuccesful. 
    Any help given would be gratefully appreciated.
    Sub Bouton1_QuandClic()
    Const ForReading = 1, ForWriting = 2, ForAppending = 3
    Dim fs, f, flname
    Dim MyPath
    Dim semaine, fichier
    Dim exc As New Excel.Application
    Dim LaDate As String
    Dim NomClasseur, nomfichier, DFU, Location, Model, Typ, FcstID, DUR As String
    Dim i, j, lig, col As Integer
    
    Dim Feuil1, Feuil_Synthese As Worksheet
    Dim appexcel As Excel.Application
    Dim WB1, WB2 As Excel.Workbook
    
    j = 2
    Ns = Sheets("Datas").Range("C2")
    DFU = Sheets("Datas").Cells(14, 5)
    Location = Sheets("Datas").Cells(15, 5)
    Model = Sheets("Datas").Cells(16, 5)
    Typ = Sheets("Datas").Cells(17, 5)
    FcstID = Sheets("Datas").Cells(18, 5)
    DUR = Sheets("Datas").Cells(19, 5)
    
    'récupération du chemin courant
    MyPath = ActiveWorkbook.Path & "\"
    
    Set fs = CreateObject("Scripting.FileSystemObject")
    
    ' Récupère la liste des fichiers dans le répertoire
    Set faps = Application.FileSearch
    With faps
     .LookIn = MyPath & "ADF Import"
     .Filename = "*.*"
     
     
     
     Workbooks.Add
     Set WB1 = ActiveWorkbook
    
     Set Feuil1 = WB1.Worksheets(1)
    
     Feuil1.Cells(1, 1).Value = "*DmdGroup"
     Feuil1.Cells(1, 2).Value = "*DmdUnit"
     Feuil1.Cells(1, 3).Value = "*Loc"
     Feuil1.Cells(1, 4).Value = "*Model"
     Feuil1.Cells(1, 5).Value = "*StartDate"
     Feuil1.Cells(1, 6).Value = "*Type"
     Feuil1.Cells(1, 7).Value = "*FcstID"
     Feuil1.Cells(1, 8).Value = "Qty"
     Feuil1.Cells(1, 9).Value = "Dur"
     
     If .Execute > 0 Then
        
      ' Tant qu'il y a des fichiers dans le répertoire
      For i = 1 To .FoundFiles.Count
        
       flname = .FoundFiles(i)
        
       ' Ouverture du fichier sélectionné
       Workbooks.Open Filename:=flname
        
       Set WB2 = ActiveWorkbook
        
       'sélection de l'onglet Summary
       Set Feuil_Summary = WB2.Worksheets("Summary")
        
       lig = 2
       col = 3
       
       ' Tant qu'il y a des données dans la feuille excel
       Do
        Do
         semaine = Feuil_Summary.Cells(1, col).Value
         DFU = Feuil_Summary.Cells(lig, 2).Value
         Codesku = Feuil_Summary.Cells(lig, 1).Value
         
         Feuil1.Cells(j, 1).Value = DFU
         Feuil1.Cells(j, 2).Value = Codesku
         Feuil1.Cells(j, 3).Value = Location
         Feuil1.Cells(j, 4).Value = Model
         Feuil1.Cells(j, 5).Value = semaine
         Feuil1.Cells(j, 6).Value = Typ
         Feuil1.Cells(j, 7).Value = FcstID
         Feuil1.Cells(j, 8).Value = Format(Feuil_Summary.Cells(lig, col).Value, "00000000000")
         Feuil1.Cells(j, 9).Value = DUR
          '"00000000000"
         j = j + 1
         col = col + 1
        Loop Until Feuil_Summary.Cells(lig, col).Value = ""
         
        lig = lig + 1
        col = 3
         
       Loop Until Feuil_Summary.Cells(lig, col).Value = ""
           
       WB2.Close
      Next i
       
     Else
      MsgBox "There were no files found."
     End If
      
    
     
    End With
    
     
    
    End Sub
    Wednesday, June 30, 2010 12:56 PM
  • 1.  I am trying janish89 's code and am getting the error "User-defined type not defined".  I have the supplied code in a class module named FileSearch2007 in PERSONAL.XLS.  Microsoft Scripting Runtime is referenced.  In my subroutine I have the following variables defined:

    Dim itemFile As Integer, dMax As Date, Search As FileSearch2007
    Set Search = New FileSearch2007
    

    Now, if I move it to the Class Modules section in my application it then works.  When it comes to Class Modules I'm a total newb so further enlightenment is appreciated.

    2.  Next issue is with .FoundFiles.Count. below.  I get a "Argument not optional" error:

    Dim itemFile As Integer, dMax As Date, Search As FileSearch2007
    Set Search = New FileSearch2007
    
    'With Application.FileSearch
    With Search
     .NewSearch
     .LookIn = sDirectory
     .FileName = sSearchExpression 'sFileName
     .SearchSubFolders = False
     .Execute
     'Find the most recent Created/Modified Date
     dMax = #1/1/1901# 'Set default date
     For itemFile = 1 To .FoundFiles.Count
      If dMax < FileDateTime(.FoundFiles(itemFile)) Then
       dMax = FileDateTime(.FoundFiles(itemFile))
       sGetRecentFile = .FoundFiles(itemFile)
      End If
     Next itemFile
    End With
    
    End Function

    I'm working with .FileCount right now instead of .FoundFiles.Count but am running into other issues so help with this is appreciated.  TIA!

     

     

    Tuesday, August 03, 2010 4:00 PM
  • Hmmm...looks like this work-around doesn't work with UNC path names.

    Nice work Microsoft, who's the clown that thought we didn't need this functionality?

    Tuesday, August 03, 2010 5:50 PM
  • Thanks James! It came in very handy!

    ...but the SearchSubFolders of your class doesn't work though.

    I debuged it so as to make it find files within the next level of subfolders (only 1 level):

    Create Class FileSearch :

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

    Public FoundFiles As New Collection
    Public FoundDirectories 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
        SearchSubFolders = 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 i As Long
        Dim sLookIn As String
        Dim sDirName As String
        Dim sCurDir As String
        Dim sFileName As String
        Dim ff As FilesFound
       
        i = 1
        Set ff = New FilesFound
        sLookIn = LookIn
        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
            sDirName = Dir(sLookIn & "\", vbDirectory)
            Do Until Len(sDirName) = 0
                sCurDir = sLookIn & "\" & sDirName
                If GetAttr(sCurDir) = vbDirectory And sDirName <> "." And sDirName <> ".." Then
                    FoundDirectories.Add (sCurDir)
                End If
                sDirName = Dir
            Loop
            Do Until i > FoundDirectories.Count
                sFileName = Dir(FoundDirectories.Item(i) & "\", vbNormal)
                Do Until Len(sFileName) = 0
                    If sFileName Like fileName Then
                        ff.AddFile FoundDirectories.Item(i), sFileName
                        FoundFiles.Add (ff.FoundFileFullName)
                    End If
                    sFileName = Dir
                Loop
                i = i + 1
             Loop
        End If
     Execute = FoundFiles.Count
    End Function
    Public Function Clear() As Long
        Set FoundFiles = Nothing
        Set FoundDirectories = Nothing
        Set FoundFiles = New Collection
        Set FoundDirectories = New Collection
    End Function

    Create Class FilesFound :

    Public FoundFileFullName As String

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

    And then use it in your Module:

        Dim SourceFilesPath As String
        Dim FileString As String
        
        SourceFilesPath = "W:\FolderToSearch\"
        FileString = "*.xls*"
        
        Dim i As Integer
        i = 1
       
       
    Dim fs As New FileSearch

         With fs
            .LookIn
    = SourceFilesPath & S
            .SearchSubFolders
    = True
            .fileName
    = FileString
            If .Execute > 0 Then
                For j = 1 To .FoundFiles.Count
                    Sheets("FilesFound").Cells(i, j).value = .FoundFiles(j)
                Next
            End If
            i = i + 1
            .Clear
        End With
       
        MsgBox "Done"
    • Edited by PrizmP Tuesday, August 03, 2010 6:38 PM Typo in code submited
    Tuesday, August 03, 2010 6:20 PM
  • Okay, after fiddle-faddling with the code (janish89 ) I got it to work but the Class Module needs to be in the same workbook as the code calling it i.e., it can't be called from Personal.xls.  Here's my function that I was able to convert from the depreciated FileSearch.

     

    Function sGetRecentFile(sDirectory As String, sSearchExpression As String) As String
    'Returns a string that contains the most recent full file path and file name of what's being searched.
    'sDirectory = a full file path using UNC e.g., "\\celio\CCREPORTS\Project RAID Reports\KANA\"
    'sSearchExpression = any valid file search expression, e.g., "*.xls"
    'The given directory (folder) is searched using the search expression given. Out of the list of files
    'returned by the search, only the file with the most recent Created/Modified Date is returned.
    'Modified date = Created date when a file is first created. After the file has been opened then the
    'Modified date gets updated and thus becomes the more recent file.

    Dim itemFile As Integer, dMax As Date
    Dim Search As FileSearch2007

    Set Search = New FileSearch2007
    With Search
    .NewSearch
    .LookIn = sDirectory
    .FileName = sSearchExpression 'sFileName
    .SearchSubFolders = False
    .Execute
    'Find the most recent Created/Modified Date
    dMax = #1/1/1901# 'Set default date
    For itemFile = 1 To .FileCount
    If dMax < FileDateTime(.FilePaths(itemFile)) Then
    dMax = FileDateTime(.FilePaths(itemFile))
    sGetRecentFile = .FilePaths(itemFile)
    End If
    Next itemFile
    End With
    Set Search = Nothing
    End Function

     

    Add an equal sign to the first condition for both these Properties (find the Properties and replace them with the below code):

     

    Public Property Get FoundFiles(Value As Integer)
    If (Value <= pFileCount And Value >= 0) Then
    FoundFiles = pFoundFiles(Value)
    Else
    MsgBox "Error - File index is too high. Only " & pFileCount & " files were found."
    FoundFiles = ""
    End If
    End Property


    Public Property Get FilePaths(Value As Integer)
    If (Value <= pFileCount And Value >= 0) Then
    FilePaths = pFilePaths(Value)
    Else
    MsgBox "Error - File index is too high. Only " & pFileCount & " files were found."
    FilePaths = ""
    End If
    End Property

     

    Finally, change the Execute Method by removing the -1 from the lines in the DO WHILE...LOOP (change already made in my below code snippet):

     

     pFoundFiles(pFileCount) = tempFile
    pFilePaths(pFileCount) = CurDir
    If Right(CurDir, 1) <> "\" Then pFilePaths(pFileCount) = CurDir & "\"
    pFilePaths(pFileCount) = pFilePaths(pFileCount) & tempFile

    Making these changes allowed my code to work properly.

    *dang this editor is buggy!

    • Proposed as answer by IvanVenuti Wednesday, August 25, 2010 7:53 AM
    Friday, August 06, 2010 5:18 PM
  • In 2007 I published a book (Programmare Office 2007 -> Programming Office 2007) for an italian magazine.

    I wrote a class to be used instead of FileSearch (the purpose is the same of the code proposed by janish89)

    My proposed class is named myFileSearch; use it like this example:

     

     Dim mFileSearch As New myFileSearch
    With mFileSearch
    .NewSearch
    .LookIn = cartella
    .FileType = msoFileTypeWordDocuments
    .SearchSubFolders = sottocartelle
    .Execute
    End With

    instead of

     

    With Application.FileSearch
    .NewSearch
    .LookIn = cartella
    .FileType = msoFileTypeWordDocuments
    .SearchSubFolders = sottocartelle
    .Execute
    End With


    The class can be download from page: http://ivenuti.altervista.org/risorse/vba.htm

    It is released as free software. Feel free to use and modify it in any of your projects.

    If you modify it I'd like to receive your improvements, but it isn't mandatory.

    Thanks

    Wednesday, August 25, 2010 7:59 AM
  • Upon further review. This code works great (period).
    Friday, September 03, 2010 8:32 PM
  • This has to be the most useful thread yet on filesearch alternatives. But i still cant find much on anything open most recent files in directories including subfolders. I’ve tried working around this but I have not been able to. Could anyone help me convert this over to 2007-2010 capable code?

    Option Explicit
    Sub Test()
        Dim pathname As String
        Dim snippet As String
        Dim wb As Workbook
        pathname = "C:\"
        snippet = "test "     'Notice the "space" after test. This will let it pull
                                   'the files test 2001-01-01

        Set wb = NewestBookWithNameSnippet(pathname, snippet)
        wb.Activate


    End Sub

    Function NewestBookWithNameSnippet(pathname As String, nameSnippet As String) As Workbook
        'Function assumes that the date is in the far right side of workbook name
        'Be careful of Capitilization of The namesnippet and be sure to include any spaces between  the
        'name snippet and the date.
        Dim fs As FileSearch, iCount As Long
        Dim MyFile  As String
        Dim TestFile As String
        Dim Largestdate As Date
        Dim testDate As Date

        Set fs = Application.FileSearch
        With fs
            .SearchSubFolders = False                ' set to true if you want sub-folders included
            .FileType = msoFileTypeExcelWorkbooks    'just Excel files
            .LookIn = pathname
            If .Execute > 0 Then

                For iCount = 1 To .FoundFiles.Count
                    TestFile = .FoundFiles(iCount)
                    Debug.Print InStr(TestFile, nameSnippet)
                    If InStr(TestFile, nameSnippet) <> 0 Then
                        testDate = Mid(.FoundFiles(iCount), Len(pathname & nameSnippet) + 1, _
                                        Len(.FoundFiles(iCount)) - Len(pathname & nameSnippet) - 4) ' "-4" is for .xls
                        If CDate(testDate) > CDate(Largestdate) Then
                            Largestdate = testDate
                            MyFile = TestFile
                        End If
                    End If
                Next iCount
            Else
                 MsgBox "No files found"
                 Exit Function
            End If
        End With

        Set fs = Nothing
        Set NewestBookWithNameSnippet = Workbooks.Open(MyFile)

    End Function

    Friday, September 17, 2010 8:02 PM
  • After trying to implement janish89  & Air_Cooled_Nut answers to get things rolling i kept getting more and more errors. Im new to all this and just wingin atm. I added Nuts function and property changes to the class module created using Janish89 code and i tried loading the Sub TestFileSearch() to make sure everything was running right but it gives me an "Type mismath" error and breaks on:

     If .Execute > 0 Then

    Any tell what thing im doing wrong?

    Monday, September 20, 2010 9:36 PM
  • Hi,

    I only have 2003 so this is just advice rather than an absolute answer. In the VBA Editor use the Object Browser and do a search (or browse) for the Application object. See if the FileSearch object is there.

    If that doesn't help can you find a feature on the GUI to do the File Search. If you can record a macro and that will give you an idea of what legacy code to use.

    I hope that helps.


    I know this post is more than 4 years old but I wonder who marked it as an answer?  It contain absolutely *nothing* that could even remotely help someone using Office 2007 address the issue of Microsoft depracating FileSearch! {grin}
    Tushar Mehta (Technology and Operations Consulting)
    www.tushar-mehta.com (Excel and PowerPoint add-ins and tutorials)
    Microsoft MVP Excel 2000-Present
    Wednesday, September 22, 2010 9:29 PM
  • Great code, PrizmP, but I only get it to find 11 files in 3 subdirectories out of 100+ files in 30+ subdirectories. No error messages, always the same 11 files, not sure why or where it decides to end the loop. Any thoughts? I'm getting desperate...

    Thanks,
    Uta

    Friday, October 01, 2010 5:21 PM
  • Hi,

     

    Im trying to use the modified code by Air_Cooled_Nut which works with a full file path using UNC but that does not seem to work, it always points to the "C:\Documents and Settings\username\My Documents". Any ideas what is wrong?

     

    Thanks,

     

    Wednesday, November 17, 2010 12:05 PM
  • I have been using this code for some time, however, I cannot get it to work with SEARCHSUBFOLDERS set to True. It only gives me files in the root directory. Any ideas?

     

    Thanks.

    Wednesday, January 26, 2011 12:12 AM
  • Hello everyone, I do not know that much about VB, but I really really really need some help. I have this code that works perfect in excel 2003, but it does not work in 2007 because of the Application.FileSearch , and I was wondering if someone can help me out, the code I have is this one:

    Sub ConsolidateFinal()
        Dim vaFileName As Variant, wbkData As Workbook
        Dim vaDataTotal As Variant, vaDataWbk As Variant, lRow As Long, lCol As Long
        Dim vaDataTotal02 As Variant, vaDataWbk02 As Variant
        Dim vaDataTotal03 As Variant, vaDataWbk03 As Variant
        Dim vaDataTotal04 As Variant, vaDataWbk04 As Variant
        Dim vaDataTotal05 As Variant, vaDataWbk05 As Variant
        Dim vaDataTotal06 As Variant, vaDataWbk06 As Variant, qRow As Long, qCol As Long
        Dim vaDataTotal07 As Variant, vaDataWbk07 As Variant
        Dim vaDataTotal08 As Variant, vaDataWbk08 As Variant
        Dim vaDataTotal09 As Variant, vaDataWbk09 As Variant
        Dim vaDataTotal10 As Variant, vaDataWbk10 As Variant
        Dim vaDataTotal11 As Variant, vaDataWbk11 As Variant
        Dim vaDataTotal12 As Variant, vaDataWbk12 As Variant
        Dim fname
        Dim fname2
        fname = "C:\Documents and settings\" & Environ("username") & "\Desktop\StopHIVAIDS"
        fname2 = "Macintosh HD:Users:Username:Desktop:StopHIVAIDS"
       
        With Application.FileSearch
            .NewSearch
            .LookIn = fname
            .LookIn = fname2
           
            .SearchSubFolders = False
            .FileType = msoFileTypeExcelWorkbooks
            If .Execute > 0 Then

                Application.ScreenUpdating = False
                ReDim vaDataTotal(1 To 1, 1 To 15) As Variant
                ReDim vaDataTotal02(1 To 1, 1 To 15) As Variant
                ReDim vaDataTotal03(1 To 1, 1 To 15) As Variant
                ReDim vaDataTotal04(1 To 1, 1 To 15) As Variant
                ReDim vaDataTotal05(1 To 1, 1 To 15) As Variant
                ReDim vaDataTotal06(1 To 2, 1 To 15) As Variant
                ReDim vaDataTotal07(1 To 2, 1 To 15) As Variant
                ReDim vaDataTotal08(1 To 2, 1 To 15) As Variant
                ReDim vaDataTotal09(1 To 2, 1 To 15) As Variant
                ReDim vaDataTotal10(1 To 2, 1 To 15) As Variant
                ReDim vaDataTotal11(1 To 2, 1 To 15) As Variant
                ReDim vaDataTotal12(1 To 2, 1 To 15) As Variant
                For Each vaFileName In .FoundFiles

                    Set wbkData = Workbooks.Open(Filename:=vaFileName)

                    With wbkData
                        vaDataWbk = .Worksheets("Data").Range("C7:Q7").Value
                        vaDataWbk02 = .Worksheets("Data").Range("C10:Q10").Value
                        vaDataWbk03 = .Worksheets("Data").Range("C16:Q16").Value
                        vaDataWbk04 = .Worksheets("Data").Range("C22:Q22").Value
                        vaDataWbk05 = .Worksheets("Data").Range("C26:Q26").Value
                        vaDataWbk06 = .Worksheets("Data").Range("C30:Q31").Value
                        vaDataWbk07 = .Worksheets("Data").Range("C35:Q36").Value
                        vaDataWbk08 = .Worksheets("Data").Range("C41:Q42").Value
                        vaDataWbk09 = .Worksheets("Data").Range("C45:Q46").Value
                        vaDataWbk10 = .Worksheets("Data").Range("C49:Q50").Value
                        vaDataWbk11 = .Worksheets("Data").Range("C53:Q54").Value
                        vaDataWbk12 = .Worksheets("Data").Range("C57:Q58").Value

                        For lCol = 1 To 15
                            For lRow = 1 To 1
                                vaDataTotal(lRow, lCol) = _
                                    vaDataTotal(lRow, lCol) + vaDataWbk(lRow, lCol)
                                vaDataTotal02(lRow, lCol) = _
                                    vaDataTotal02(lRow, lCol) + vaDataWbk02(lRow, lCol)
                                vaDataTotal03(lRow, lCol) = _
                                    vaDataTotal03(lRow, lCol) + vaDataWbk03(lRow, lCol)
                                vaDataTotal04(lRow, lCol) = _
                                    vaDataTotal04(lRow, lCol) + vaDataWbk04(lRow, lCol)
                                vaDataTotal05(lRow, lCol) = _
                                    vaDataTotal05(lRow, lCol) + vaDataWbk05(lRow, lCol)
                            Next lRow
                        Next lCol
                        For qCol = 1 To 15
                            For qRow = 1 To 2
                                vaDataTotal06(qRow, qCol) = _
                                    vaDataTotal06(qRow, qCol) + vaDataWbk06(qRow, qCol)
                                vaDataTotal07(qRow, qCol) = _
                                    vaDataTotal07(qRow, qCol) + vaDataWbk07(qRow, qCol)
                                vaDataTotal08(qRow, qCol) = _
                                    vaDataTotal08(qRow, qCol) + vaDataWbk08(qRow, qCol)
                                vaDataTotal09(qRow, qCol) = _
                                    vaDataTotal09(qRow, qCol) + vaDataWbk09(qRow, qCol)
                                vaDataTotal10(qRow, qCol) = _
                                    vaDataTotal10(qRow, qCol) + vaDataWbk10(qRow, qCol)
                                vaDataTotal11(qRow, qCol) = _
                                    vaDataTotal11(qRow, qCol) + vaDataWbk11(qRow, qCol)
                                vaDataTotal12(qRow, qCol) = _
                                    vaDataTotal12(qRow, qCol) + vaDataWbk12(qRow, qCol)
                            Next qRow
                        Next qCol

                        .Close savechanges:=False

                    End With
                Next vaFileName
                ThisWorkbook.Worksheets("Data").Range("C7:Q7").Value = vaDataTotal
                ThisWorkbook.Worksheets("Data").Range("C10:Q10").Value = vaDataTotal02
                ThisWorkbook.Worksheets("Data").Range("C16:Q16").Value = vaDataTotal03
                ThisWorkbook.Worksheets("Data").Range("C22:Q22").Value = vaDataTotal04
                ThisWorkbook.Worksheets("Data").Range("C26:Q26").Value = vaDataTotal05
                ThisWorkbook.Worksheets("Data").Range("C30:Q31").Value = vaDataTotal06
                ThisWorkbook.Worksheets("Data").Range("C35:Q36").Value = vaDataTotal07
                ThisWorkbook.Worksheets("Data").Range("C41:Q42").Value = vaDataTotal08
                ThisWorkbook.Worksheets("Data").Range("C45:Q46").Value = vaDataTotal09
                ThisWorkbook.Worksheets("Data").Range("C49:Q50").Value = vaDataTotal10
                ThisWorkbook.Worksheets("Data").Range("C53:Q54").Value = vaDataTotal11
                ThisWorkbook.Worksheets("Data").Range("C57:Q58").Value = vaDataTotal12
                Application.ScreenUpdating = True
            Else
                MsgBox "There were no Excel files found."
            End If
        End With

    End Sub

    Please if someone can help me to get this to work I really appreciate it a lot!!! I have been trying to fix it for two days in a row, and I can't, and my job kinda depends on it, I am desperate and don't know what else to do.

    THANK YOU!

    • Proposed as answer by Flaco9698 Wednesday, February 16, 2011 6:37 PM
    Wednesday, February 16, 2011 2:53 AM

  • Have you looked at the myriad of answers in this discussion that address alternatives and replacements for FileSearch?

    I'll add one more. {grin}

    Put the searchForFiles procedure from http://www.tushar-mehta.com/publish_train/xl_vba_cases/process_all_files_in_folder.htm in a standard module.  Please remember to include the comments above the subroutine.

    Then, put the code below in a separate module.  Run the getGoing subroutine.  Given that I don't have any files with the data that you have the code is largely *untested.*

    Option Explicit
      Dim vaDataTotal As Variant, vaDataWbk As Variant
      Dim vaDataTotal02 As Variant, vaDataWbk02 As Variant
      Dim vaDataTotal03 As Variant, vaDataWbk03 As Variant
      Dim vaDataTotal04 As Variant, vaDataWbk04 As Variant
      Dim vaDataTotal05 As Variant, vaDataWbk05 As Variant
      Dim vaDataTotal06 As Variant, vaDataWbk06 As Variant
      Dim vaDataTotal07 As Variant, vaDataWbk07 As Variant
      Dim vaDataTotal08 As Variant, vaDataWbk08 As Variant
      Dim vaDataTotal09 As Variant, vaDataWbk09 As Variant
      Dim vaDataTotal10 As Variant, vaDataWbk10 As Variant
      Dim vaDataTotal11 As Variant, vaDataWbk11 As Variant
      Dim vaDataTotal12 As Variant, vaDataWbk12 As Variant
    Sub getGoing()
      Application.ScreenUpdating = False
      ReDim vaDataTotal(1 To 1, 1 To 15) As Variant
      ReDim vaDataTotal02(1 To 1, 1 To 15) As Variant
      ReDim vaDataTotal03(1 To 1, 1 To 15) As Variant
      ReDim vaDataTotal04(1 To 1, 1 To 15) As Variant
      ReDim vaDataTotal05(1 To 1, 1 To 15) As Variant
      ReDim vaDataTotal06(1 To 2, 1 To 15) As Variant
      ReDim vaDataTotal07(1 To 2, 1 To 15) As Variant
      ReDim vaDataTotal08(1 To 2, 1 To 15) As Variant
      ReDim vaDataTotal09(1 To 2, 1 To 15) As Variant
      ReDim vaDataTotal10(1 To 2, 1 To 15) As Variant
      ReDim vaDataTotal11(1 To 2, 1 To 15) As Variant
      ReDim vaDataTotal12(1 To 2, 1 To 15) As Variant
      
      Dim fName As String
      If InStr(1, Application.OperatingSystem, "Windows", vbTextCompare) > 0 Then
        fName = "C:\Documents and settings\" & Environ("username") & "\Desktop\StopHIVAIDS"
      Else
        fName = "Macintosh HD:Users:Username:Desktop:StopHIVAIDS"
        End If
      searchForFiles fName, "processADataFile", "*.xls", False
      
      ThisWorkbook.Worksheets("Data").Range("C7:Q7").Value = vaDataTotal
      ThisWorkbook.Worksheets("Data").Range("C10:Q10").Value = vaDataTotal02
      ThisWorkbook.Worksheets("Data").Range("C16:Q16").Value = vaDataTotal03
      ThisWorkbook.Worksheets("Data").Range("C22:Q22").Value = vaDataTotal04
      ThisWorkbook.Worksheets("Data").Range("C26:Q26").Value = vaDataTotal05
      ThisWorkbook.Worksheets("Data").Range("C30:Q31").Value = vaDataTotal06
      ThisWorkbook.Worksheets("Data").Range("C35:Q36").Value = vaDataTotal07
      ThisWorkbook.Worksheets("Data").Range("C41:Q42").Value = vaDataTotal08
      ThisWorkbook.Worksheets("Data").Range("C45:Q46").Value = vaDataTotal09
      ThisWorkbook.Worksheets("Data").Range("C49:Q50").Value = vaDataTotal10
      ThisWorkbook.Worksheets("Data").Range("C53:Q54").Value = vaDataTotal11
      ThisWorkbook.Worksheets("Data").Range("C57:Q58").Value = vaDataTotal12
      Application.ScreenUpdating = True
      End Sub
    Sub processADataFile(ByVal vaFileName As String)
      Dim wbkData As Workbook
      Dim lRow As Long, lCOl As Long, _
        qRow As Long, qCol As Long
      Debug.Print vaFileName
      'GoTo XIT
      Set wbkData = Workbooks.Open(Filename:=vaFileName)
      With wbkData
      vaDataWbk = .Worksheets("Data").Range("C7:Q7").Value
      vaDataWbk02 = .Worksheets("Data").Range("C10:Q10").Value
      vaDataWbk03 = .Worksheets("Data").Range("C16:Q16").Value
      vaDataWbk04 = .Worksheets("Data").Range("C22:Q22").Value
      vaDataWbk05 = .Worksheets("Data").Range("C26:Q26").Value
      vaDataWbk06 = .Worksheets("Data").Range("C30:Q31").Value
      vaDataWbk07 = .Worksheets("Data").Range("C35:Q36").Value
      vaDataWbk08 = .Worksheets("Data").Range("C41:Q42").Value
      vaDataWbk09 = .Worksheets("Data").Range("C45:Q46").Value
      vaDataWbk10 = .Worksheets("Data").Range("C49:Q50").Value
      vaDataWbk11 = .Worksheets("Data").Range("C53:Q54").Value
      vaDataWbk12 = .Worksheets("Data").Range("C57:Q58").Value
      For lCOl = 1 To 15
        For lRow = 1 To 1
          vaDataTotal(lRow, lCOl) = _
            vaDataTotal(lRow, lCOl) + vaDataWbk(lRow, lCOl)
          vaDataTotal02(lRow, lCOl) = _
            vaDataTotal02(lRow, lCOl) + vaDataWbk02(lRow, lCOl)
          vaDataTotal03(lRow, lCOl) = _
            vaDataTotal03(lRow, lCOl) + vaDataWbk03(lRow, lCOl)
          vaDataTotal04(lRow, lCOl) = _
            vaDataTotal04(lRow, lCOl) + vaDataWbk04(lRow, lCOl)
          vaDataTotal05(lRow, lCOl) = _
            vaDataTotal05(lRow, lCOl) + vaDataWbk05(lRow, lCOl)
          Next lRow
        Next lCOl
      For qCol = 1 To 15
        For qRow = 1 To 2
          vaDataTotal06(qRow, qCol) = _
            vaDataTotal06(qRow, qCol) + vaDataWbk06(qRow, qCol)
          vaDataTotal07(qRow, qCol) = _
            vaDataTotal07(qRow, qCol) + vaDataWbk07(qRow, qCol)
          vaDataTotal08(qRow, qCol) = _
            vaDataTotal08(qRow, qCol) + vaDataWbk08(qRow, qCol)
          vaDataTotal09(qRow, qCol) = _
            vaDataTotal09(qRow, qCol) + vaDataWbk09(qRow, qCol)
          vaDataTotal10(qRow, qCol) = _
            vaDataTotal10(qRow, qCol) + vaDataWbk10(qRow, qCol)
          vaDataTotal11(qRow, qCol) = _
            vaDataTotal11(qRow, qCol) + vaDataWbk11(qRow, qCol)
          vaDataTotal12(qRow, qCol) = _
            vaDataTotal12(qRow, qCol) + vaDataWbk12(qRow, qCol)
          Next qRow
        Next qCol
      .Close savechanges:=False
        End With
    XIT:
      End Sub
    

     

    Hello everyone, I do not know that much about VB, but I really really really need some help. I have this code that works perfect in excel 2003, but it does not work in 2007 because of the Application.FileSearch , and I was wondering if someone can help me out, the code I have is this one:

    Sub ConsolidateFinal()
        Dim vaFileName As Variant, wbkData As Workbook
        Dim vaDataTotal As Variant, vaDataWbk As Variant, lRow As Long, lCol As Long
        Dim vaDataTotal02 As Variant, vaDataWbk02 As Variant
        Dim vaDataTotal03 As Variant, vaDataWbk03 As Variant
        Dim vaDataTotal04 As Variant, vaDataWbk04 As Variant
        Dim vaDataTotal05 As Variant, vaDataWbk05 As Variant
        Dim vaDataTotal06 As Variant, vaDataWbk06 As Variant, qRow As Long, qCol As Long
        Dim vaDataTotal07 As Variant, vaDataWbk07 As Variant
        Dim vaDataTotal08 As Variant, vaDataWbk08 As Variant
        Dim vaDataTotal09 As Variant, vaDataWbk09 As Variant
        Dim vaDataTotal10 As Variant, vaDataWbk10 As Variant
        Dim vaDataTotal11 As Variant, vaDataWbk11 As Variant
        Dim vaDataTotal12 As Variant, vaDataWbk12 As Variant
        Dim fname
        Dim fname2
        fname = "C:\Documents and settings\" & Environ("username") & "\Desktop\StopHIVAIDS"
        fname2 = "Macintosh HD:Users:Username:Desktop:StopHIVAIDS"
       
        With Application.FileSearch
            .NewSearch
            .LookIn = fname
            .LookIn = fname2
           
            .SearchSubFolders = False
            .FileType = msoFileTypeExcelWorkbooks
            If .Execute > 0 Then

                Application.ScreenUpdating = False
                ReDim vaDataTotal(1 To 1, 1 To 15) As Variant
                ReDim vaDataTotal02(1 To 1, 1 To 15) As Variant
                ReDim vaDataTotal03(1 To 1, 1 To 15) As Variant
                ReDim vaDataTotal04(1 To 1, 1 To 15) As Variant
                ReDim vaDataTotal05(1 To 1, 1 To 15) As Variant
                ReDim vaDataTotal06(1 To 2, 1 To 15) As Variant
                ReDim vaDataTotal07(1 To 2, 1 To 15) As Variant
                ReDim vaDataTotal08(1 To 2, 1 To 15) As Variant
                ReDim vaDataTotal09(1 To 2, 1 To 15) As Variant
                ReDim vaDataTotal10(1 To 2, 1 To 15) As Variant
                ReDim vaDataTotal11(1 To 2, 1 To 15) As Variant
                ReDim vaDataTotal12(1 To 2, 1 To 15) As Variant
                For Each vaFileName In .FoundFiles

                    Set wbkData = Workbooks.Open(Filename:=vaFileName)

                    With wbkData
                        vaDataWbk = .Worksheets("Data").Range("C7:Q7").Value
                        vaDataWbk02 = .Worksheets("Data").Range("C10:Q10").Value
                        vaDataWbk03 = .Worksheets("Data").Range("C16:Q16").Value
                        vaDataWbk04 = .Worksheets("Data").Range("C22:Q22").Value
                        vaDataWbk05 = .Worksheets("Data").Range("C26:Q26").Value
                        vaDataWbk06 = .Worksheets("Data").Range("C30:Q31").Value
                        vaDataWbk07 = .Worksheets("Data").Range("C35:Q36").Value
                        vaDataWbk08 = .Worksheets("Data").Range("C41:Q42").Value
                        vaDataWbk09 = .Worksheets("Data").Range("C45:Q46").Value
                        vaDataWbk10 = .Worksheets("Data").Range("C49:Q50").Value
                        vaDataWbk11 = .Worksheets("Data").Range("C53:Q54").Value
                        vaDataWbk12 = .Worksheets("Data").Range("C57:Q58").Value

                        For lCol = 1 To 15
                            For lRow = 1 To 1
                                vaDataTotal(lRow, lCol) = _
                                    vaDataTotal(lRow, lCol) + vaDataWbk(lRow, lCol)
                                vaDataTotal02(lRow, lCol) = _
                                    vaDataTotal02(lRow, lCol) + vaDataWbk02(lRow, lCol)
                                vaDataTotal03(lRow, lCol) = _
                                    vaDataTotal03(lRow, lCol) + vaDataWbk03(lRow, lCol)
                                vaDataTotal04(lRow, lCol) = _
                                    vaDataTotal04(lRow, lCol) + vaDataWbk04(lRow, lCol)
                                vaDataTotal05(lRow, lCol) = _
                                    vaDataTotal05(lRow, lCol) + vaDataWbk05(lRow, lCol)
                            Next lRow
                        Next lCol
                        For qCol = 1 To 15
                            For qRow = 1 To 2
                                vaDataTotal06(qRow, qCol) = _
                                    vaDataTotal06(qRow, qCol) + vaDataWbk06(qRow, qCol)
                                vaDataTotal07(qRow, qCol) = _
                                    vaDataTotal07(qRow, qCol) + vaDataWbk07(qRow, qCol)
                                vaDataTotal08(qRow, qCol) = _
                                    vaDataTotal08(qRow, qCol) + vaDataWbk08(qRow, qCol)
                                vaDataTotal09(qRow, qCol) = _
                                    vaDataTotal09(qRow, qCol) + vaDataWbk09(qRow, qCol)
                                vaDataTotal10(qRow, qCol) = _
                                    vaDataTotal10(qRow, qCol) + vaDataWbk10(qRow, qCol)
                                vaDataTotal11(qRow, qCol) = _
                                    vaDataTotal11(qRow, qCol) + vaDataWbk11(qRow, qCol)
                                vaDataTotal12(qRow, qCol) = _
                                    vaDataTotal12(qRow, qCol) + vaDataWbk12(qRow, qCol)
                            Next qRow
                        Next qCol

                        .Close savechanges:=False

                    End With
                Next vaFileName
                ThisWorkbook.Worksheets("Data").Range("C7:Q7").Value = vaDataTotal
                ThisWorkbook.Worksheets("Data").Range("C10:Q10").Value = vaDataTotal02
                ThisWorkbook.Worksheets("Data").Range("C16:Q16").Value = vaDataTotal03
                ThisWorkbook.Worksheets("Data").Range("C22:Q22").Value = vaDataTotal04
                ThisWorkbook.Worksheets("Data").Range("C26:Q26").Value = vaDataTotal05
                ThisWorkbook.Worksheets("Data").Range("C30:Q31").Value = vaDataTotal06
                ThisWorkbook.Worksheets("Data").Range("C35:Q36").Value = vaDataTotal07
                ThisWorkbook.Worksheets("Data").Range("C41:Q42").Value = vaDataTotal08
                ThisWorkbook.Worksheets("Data").Range("C45:Q46").Value = vaDataTotal09
                ThisWorkbook.Worksheets("Data").Range("C49:Q50").Value = vaDataTotal10
                ThisWorkbook.Worksheets("Data").Range("C53:Q54").Value = vaDataTotal11
                ThisWorkbook.Worksheets("Data").Range("C57:Q58").Value = vaDataTotal12
                Application.ScreenUpdating = True
            Else
                MsgBox "There were no Excel files found."
            End If
        End With

    End Sub

    Please if someone can help me to get this to work I really appreciate it a lot!!! I have been trying to fix it for two days in a row, and I can't, and my job kinda depends on it, I am desperate and don't know what else to do.

    THANK YOU!


    Tushar Mehta (Technology and Operations Consulting)
    www.tushar-mehta.com (Excel and PowerPoint add-ins and tutorials)
    Microsoft MVP Excel 2000-Present
    • Proposed as answer by Flaco9698 Wednesday, February 16, 2011 6:38 PM
    Wednesday, February 16, 2011 4:04 AM
  • Thank you soooo much, it worked perfectly!!! I have one more question, how can I add a message, so if there are no excel files in the folder, it will give me a message with something like "No excel messages in folder" is that possible?

    Again, thank you so much, you are a life saver Tushar Mehta!

    • Proposed as answer by Flaco9698 Wednesday, February 16, 2011 6:38 PM
    Wednesday, February 16, 2011 6:27 AM
  • 1) Just before the

    Sub getGoing()
    

    add

    Dim NbrFilesProcessed As Long
    

    2) Replace all the assignments

    ThisWorkbook.Worksheets("Data")... 
    

    with

      If NbrFilesProcessed = 0 Then
        MsgBox "No files processed"
      Else
        ThisWorkbook.Worksheets("Data").Range("C7:Q7").Value = vaDataTotal
        ThisWorkbook.Worksheets("Data").Range("C10:Q10").Value = vaDataTotal02
        ThisWorkbook.Worksheets("Data").Range("C16:Q16").Value = vaDataTotal03
        ThisWorkbook.Worksheets("Data").Range("C22:Q22").Value = vaDataTotal04
        ThisWorkbook.Worksheets("Data").Range("C26:Q26").Value = vaDataTotal05
        ThisWorkbook.Worksheets("Data").Range("C30:Q31").Value = vaDataTotal06
        ThisWorkbook.Worksheets("Data").Range("C35:Q36").Value = vaDataTotal07
        ThisWorkbook.Worksheets("Data").Range("C41:Q42").Value = vaDataTotal08
        ThisWorkbook.Worksheets("Data").Range("C45:Q46").Value = vaDataTotal09
        ThisWorkbook.Worksheets("Data").Range("C49:Q50").Value = vaDataTotal10
        ThisWorkbook.Worksheets("Data").Range("C53:Q54").Value = vaDataTotal11
        ThisWorkbook.Worksheets("Data").Range("C57:Q58").Value = vaDataTotal12
        Application.ScreenUpdating = True
        End If
    

    and

    3) In

    Sub processADataFile(ByVal vaFileName As String)
    

    just before

     Debug.Print vaFileName
    

    add

     NbrFilesProcessed = NbrFilesProcessed + 1
    

     

    Thank you soooo much, it worked perfectly!!! I have one more question, how can I add a message, so if there are no excel files in the folder, it will give me a message with something like "No excel messages in folder" is that possible?

    Again, thank you so much, you are a life saver Tushar Mehta!


    Tushar Mehta (Technology and Operations Consulting)
    www.tushar-mehta.com (Excel and PowerPoint add-ins and tutorials)
    Microsoft MVP Excel 2000-Present
    • Proposed as answer by Flaco9698 Wednesday, February 16, 2011 6:38 PM
    Wednesday, February 16, 2011 6:46 AM
  • Again, thank you so much, it worked like a charm!!!! You rock!!!
    • Proposed as answer by Flaco9698 Wednesday, February 16, 2011 6:38 PM
    Wednesday, February 16, 2011 4:26 PM
  • Again, thank you so much, it worked like a charm!!!! You rock!!!


    You are welcome.

    Take a moment to mark the posts as answers.


    Tushar Mehta (Technology and Operations Consulting)
    www.tushar-mehta.com (Excel and PowerPoint add-ins and tutorials)
    Microsoft MVP Excel 2000-Present
    • Proposed as answer by Flaco9698 Wednesday, February 16, 2011 6:38 PM
    Wednesday, February 16, 2011 4:36 PM
  • Hello Tushar Mehta,

    Sorry to bother you so much, but maybe you can help me once more. All the workbooks that open and copy the info, they have other sheets with one chart per sheet, is it posible to copy each chart of each document and then have all the chart1 of all the documents copied and paste them in one sheet of the cosolidated workbook, then all the chart2 copied in a different sheet and so forth. And on the top of each sheet have the chart1 of that consolidated document as the main chart folowed by all the other charts? small size of course.

    I don't know if I have explained myself, hahahaha. I have searched and searched and cannot find how to do it. Well, let me know if you can help me. Thank you soooo much.

    Monday, February 21, 2011 5:12 PM
  • Anybody can tell me how to modify this code to make it work?

     

    With Application.FileSearch
                .NewSearch
                .LookIn = Path
                .SearchSubFolders = True
                .Filename = FName_Short
                .FileType = msoFileTypeAllFiles
                If .Execute() > 0 Then
                    For i = 1 To .FoundFiles.Count
                        If MsgBox("Do you want to overwrite existing  " + .FoundFiles(i) + _
                            "?", vbYesNo) = vbNo Then
                            GoTo 10
                        End If
                    Next i
                End If
            End With

    Tuesday, February 22, 2011 3:41 PM
  • Hello everyone,

    Ok, so I was able to copy all the charts as images to the tabs, but now when it pastes them, they are getting pasted on on top of the other, is there a way I can tell it to paste the first image in A1, the second image in K1, the third image in A20 and so furth? Any help would be greattly appreciated, thank you!

    Wednesday, February 23, 2011 5:53 PM
  • Hello everyone,

    Ok, so I was able to copy all the charts as images to the tabs, but now when it pastes them, they are getting pasted on on top of the other, is there a way I can tell it to paste the first image in A1, the second image in K1, the third image in A20 and so furth? Any help would be greattly appreciated, thank you!


    Use the lightly tested

    Option Explicit
    Sub relocateObj()
      With ActiveSheet.Shapes 'adjust to use the destination sheet rather than activesheet
      Dim aCell As Range
      Set aCell = Cells(((.Count - 1) \ 2) * 19 + 1, ((.Count - 1) Mod 2) * 10 + 1)
      With .Item(.Count)
      .Left = aCell.Left
      .Top = aCell.Top
        End With
        End With
      End Sub
    

    Tushar Mehta (Technology and Operations Consulting)
    www.tushar-mehta.com (Excel and PowerPoint add-ins and tutorials)
    Microsoft MVP Excel 2000-Present
    Wednesday, February 23, 2011 6:22 PM
  • Thanks Tushar,

    I tried the macro and it gives me an error: Method 'Cels' of object '_Global' failed.

    This is what I have to paste the graphs, and re-size them. They get pasted one on top of the other. Is it here were I need to paste your code? I tried it but it still gives me that error.

    Sub SizeandPosition()
    Dim Wef As Workbook

        Set Wef = Workbooks("Test.xlsm")
        Wef.Activate
       
              Worksheets("Sheet2").Activate

        Range("A1").Select

        ActiveSheet.Paste
       
    Dim myChtObj As Object
    Dim myInput As String

    For Each myChtObj In ActiveSheet.DrawingObjects
    myChtObj.Width = 500
    myChtObj.Height = 450
    Next myChtObj

    End Sub

    Before this, I am using the code you sent me before, and added this, just before .Close savechanges:=False and after Next qCol:

        Sheets("Sheet1").Select
    ActiveChart.ChartArea.Copy
     
      Call SizeandPosition

    That way it copies the graphs and when it calls the other sub, it pastes them, and then comes back and closes the files. I really don't know if this is the best way to do it, but it worked, but as I said it pastes them one on top of the other.

    Thank you soo much, please help me.

    Wednesday, February 23, 2011 7:01 PM

  • Cells not Cels.

    Also, if the sheet is not the activesheet you should adjust to reference to Cells(...) to mySheet.Cells(...) where mySheet is a variable that refers to the correct sheet.

    Thanks Tushar,

    I tried the macro and it gives me an error: Method 'Cels' of object '_Global' failed.

    This is what I have to paste the graphs, and re-size them. They get pasted one on top of the other. Is it here were I need to paste your code? I tried it but it still gives me that error.

    Sub SizeandPosition()
    Dim Wef As Workbook

        Set Wef = Workbooks("Test.xlsm")
        Wef.Activate
       
              Worksheets("Sheet2").Activate

        Range("A1").Select

        ActiveSheet.Paste
       
    Dim myChtObj As Object
    Dim myInput As String

    For Each myChtObj In ActiveSheet.DrawingObjects
    myChtObj.Width = 500
    myChtObj.Height = 450
    Next myChtObj

    End Sub

    Before this, I am using the code you sent me before, and added this, just before .Close savechanges:=False and after Next qCol:

        Sheets("Sheet1").Select
    ActiveChart.ChartArea.Copy
     
      Call SizeandPosition

    That way it copies the graphs and when it calls the other sub, it pastes them, and then comes back and closes the files. I really don't know if this is the best way to do it, but it worked, but as I said it pastes them one on top of the other.

    Thank you soo much, please help me.


    Tushar Mehta (Technology and Operations Consulting)
    www.tushar-mehta.com (Excel and PowerPoint add-ins and tutorials)
    Microsoft MVP Excel 2000-Present
    Wednesday, February 23, 2011 7:10 PM
  • It is the active sheet, but I tried changing that as well, and when the graph is not selected it gives me no error, but nothing happens, I think I am putting the code in the wrong place. Were should it be? thank you sooooo much.
    Wednesday, February 23, 2011 7:28 PM
  • It is the active sheet, but I tried changing that as well, and when the graph is not selected it gives me no error, but nothing happens, I think I am putting the code in the wrong place. Were should it be? thank you sooooo much.

    It should be after you do the paste.
    Tushar Mehta (Technology and Operations Consulting)
    www.tushar-mehta.com (Excel and PowerPoint add-ins and tutorials)
    Microsoft MVP Excel 2000-Present
    Wednesday, February 23, 2011 7:37 PM
  • Thank you Tushar,

    I just realized something, it is not pasting correctly :(  Right now I have it like this:

     vaDataTotal12(qRow, qCol) = _
            vaDataTotal12(qRow, qCol) + vaDataWbk12(qRow, qCol)
          Next qRow
        Next qCol
     

        Sheets("Sheet1").Select
    ActiveChart.ChartArea.Copy

      Call Test1

        Sheets("Sheet2").Select
    ActiveChart.ChartArea.Copy

     
      Call Test2

      .Close savechanges:=False

    The first part works great, it copies all the individual charts of sheet1 of each file, and pastes them correctly in a sheet of the consolidated document. Then when it goes to copy the graphs of sheet2, it does not copy the individual graphs of the files, it copies the graphs from the consolidated document, and pastes ten copies of it... Please help, what am I doing wrong?

    Thank you once more for your help!!

    Wednesday, February 23, 2011 9:27 PM
  • Thank you.  Rebuilding the class is a great idea and works well.

    Thanks again.

    Thursday, February 24, 2011 8:37 PM
  • Hi again,

    So everything is working great, the only thing is that when tested in excel 2007, the code:

    Option Explicit
    Sub relocateObj()
     With ActiveSheet.Shapes Dim aCell As Range
     Set aCell = Cells(((.Count - 1) \ 2) * 19 + 1, ((.Count - 1) Mod 2) * 10 + 1)
     With .Item(.Count)
     .Left = aCell.Left
     .Top = aCell.Top
      End With
      End With
     End Sub
    
    Does not work, it does nothing to the charts that have been pasted. Is there anything else I can use intead of .Shapes so that it will recognize the charts in excel 2007? it works great in 2003 but not in 2007. Thank you in advance for any help
    Friday, February 25, 2011 4:49 PM
  • As well, does anyone know why Excell 2007 randomly changes the tab names to chart1, chart2... when I close the file and open it again, it has the correct names again. It is wierd. Well if anyone know, thank you sooo much.
    Friday, February 25, 2011 5:42 PM
  • Hi, Can someone help me with a replacement for this FileSearch, I will really appreciate the help or the ideas, I looked through the posts here they were helpful, but I dont know if they will work fine in my code.

     

    The help is highly appreciated

     

    'read case number and define output file name

        Windows(bndryfile).Activate

            ActiveCell.Offset(0, 11).Select

            casenum = ActiveCell

            caselength = Len(casenum)

            yft_casenum = "000000"

            yft_casenum = Left(yft_casenum, 6 - caselength) & casenum

            fname = YFT_model & ".033." & yft_casenum

    'Open YFT output file

        With Application.FileSearch

            .NewSearch

            .LookIn = folder

            .SearchSubFolders = False

            .Filename = fname

            .MatchTextExactly = True

            .FileType = msoFileTypeAllFiles

            .Execute

            numfiles = .FoundFiles.Count

            If numfiles = 0 Then

                nofile = MsgBox("File: " & fname & " not found!" & Chr(13) & Chr(13) & " -Check cell B5 in BC spreadsheet" & Chr(13) & " -Please try again", vbCritical)

                Exit Sub

            End If

        End With

       

        ChDir (folder)

            Workbooks.OpenText Filename:= _

            folder & "\" & fname, Origin _

            :=xlWindows, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _

            xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, Semicolon:=False _

            , Comma:=False, Space:=True, Other:=False, FieldInfo:=Array(Array(1, 1), _

            Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1))

     

    Monday, March 28, 2011 1:20 PM
  • From what I can tell you are using FileSearch simply to verify that the file exists.  If that is correct, in place of the With Application.FileSearch ... End With use (the untested)

    if dir(folder & application.pathseparator & fname)="" then
      'error about missing file
      exit sub
      end if
    

     

    Hi, Can someone help me with a replacement for this FileSearch, I will really appreciate the help or the ideas, I looked through the posts here they were helpful, but I dont know if they will work fine in my code.

     

    The help is highly appreciated

     

    'read case number and define output file name

        Windows(bndryfile).Activate

            ActiveCell.Offset(0, 11).Select

            casenum = ActiveCell

            caselength = Len(casenum)

            yft_casenum = "000000"

            yft_casenum = Left(yft_casenum, 6 - caselength) & casenum

            fname = YFT_model & ".033." & yft_casenum

    'Open YFT output file

        With Application.FileSearch

            .NewSearch

            .LookIn = folder

            .SearchSubFolders = False

            .Filename = fname

            .MatchTextExactly = True

            .FileType = msoFileTypeAllFiles

            .Execute

            numfiles = .FoundFiles.Count

            If numfiles = 0 Then

                nofile = MsgBox("File: " & fname & " not found!" & Chr(13) & Chr(13) & " -Check cell B5 in BC spreadsheet" & Chr(13) & " -Please try again", vbCritical)

                Exit Sub

            End If

        End With

       

        ChDir (folder)

            Workbooks.OpenText Filename:= _

            folder & "\" & fname, Origin _

            :=xlWindows, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _

            xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, Semicolon:=False _

            , Comma:=False, Space:=True, Other:=False, FieldInfo:=Array(Array(1, 1), _

            Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1))

     


    Tushar Mehta (Technology and Operations Consulting)
    www.tushar-mehta.com (Excel and PowerPoint add-ins and tutorials)
    Microsoft MVP Excel 2000-Present
    Monday, March 28, 2011 3:59 PM
  • Jean Paul ,

    I know it has been years but this is an excellent  bit of code and worked perfectly with my application.  Nice job and thanks much

     

    Cheers, Martin


    Cheers, Martin
    • Proposed as answer by karthik_vdp Wednesday, July 06, 2011 4:44 PM
    Tuesday, July 05, 2011 7:54 PM
  • Hello Everyone,

    I used Application.FileSearch then. 

    Now I am tying to do it again but unfortunately there is an error prompted stating that With Application.FileSearch'. Could you please modify query and send to me... do you have any alternate query?

    Thanks a Lot in advance... 

    -------------------

     Sub Batch_Macro()
    Dim TbLkn As String
    Dim o_wbCurrTempl As Workbook       'Template workbook
    Dim o_wsTempl   As Worksheet        'Template worksheet

        Application.DisplayAlerts = False
        Application.ScreenUpdating = False
       
        TbLkn = InputBox("Enter the Path to process")
       
        If TbLkn = "" Then Exit Sub
       
        Set fs = Application.FileSearch

        With fs
            .LookIn = TbLkn
            .SearchSubFolders = True
            .Filename = "*.xls"
           
            If .Execute() > 0 Then
                For i = 1 To .FoundFiles.Count
                    Workbooks.Open .FoundFiles(i)
                    
                    Call Macro1
                    
                    ActiveWorkbook.SaveAs ActiveWorkbook.FullName, xlNormal
                    ActiveWorkbook.Close SaveChanges:=True
                Next i
               
                MsgBox "Processed " & .FoundFiles.Count & " files successfully"
               
            Else
                MsgBox "No files found for processing", vbCritical
            End If
        End With
           
        Application.DisplayAlerts = True
        Application.ScreenUpdating = True
       
    End Sub 

    ---------------------

    Regards

    Karthik



    Wednesday, July 06, 2011 5:13 PM
  •  

    I totally agree on this.

    Some people here suggest alternatives but these alternastives as far as I know does not give the possibility of doing a search for a specific string inside files(File Content).

    Microsoft: Please give us a proper alternative or give us this FileSearch functionality back as soon as possible in an update.

    Have a nice day..:-)

     

    Wednesday, July 20, 2011 6:47 AM
  • I've updated to excel 2007 and I'm stuck with no Application.FileSearch :(

    Could someone help me with the following code?

     

    Sub OperacjeHurtowe()
    Dim wbkSkoroszyt As Workbook
    Dim i, wiersz As Long
    Dim sciezka As String
    dato = Range("B3") ' nazwa folderu z  datą do pobrania danych
    ' określam ścieżkę szukania jako podkatalg dato katalogu gdzie znajduje się skoroszyt Zbiorczy
    sciezka = ThisWorkbook.Path & "\" & dato
    wiersz = 2 ' zmienna określająca bieżący wiersz w arkuszu gdzie zbieram dane
     
      With Application.FileSearch   ' zaczynam pracę z obiektem FileSearch
            .NewSearch                                ' nowe szukanie
            .LookIn = sciezka                  ' ścieżka poszukiwań
            .SearchSubFolders = False   ' szukanie w podfolderach - nie
            .Filename = "*.xls"              ' nazwa plików
            .FileType = msoFileTypeExcelWorkbooks ' typ pliku - Excel
             
            ' jeżeli liczba znalezionych (i posortowanych przy okazji) jest większa od zero
            If .Execute(msoSortByFileName) > 0 Then
                    ' robię pętlę od 1 do liczby znalezionych plików
                    For i = 1 To .FoundFiles.Count
                            ' otwieram 1 odnaleziony skoroszyt (a w następnych obiegach pętli  2,3 aż do ilości znalezionych)
                            Set wbkSkoroszyt = Workbooks.Open(.FoundFiles(i))
                            'aktywuję ten skoroszyt
                            wbkSkoroszyt.Activate
                            'Wpisuję nazwę otwartego skoroszytu do arkusza zbiorczego jako nazwę działu (bez 4 końcowych znaków czyli bez .xls)
                            Workbooks("start.xls").Worksheets(2).Range("A" & wiersz) = Mid(wbkSkoroszyt.Name, 1, Len(wbkSkoroszyt.Name) - 4)
                            'przesuwam wiersz o jeden
                            'wiersz = wiersz + 1 '
                            With wbkSkoroszyt.Worksheets(1) ' w pierwszym arkuszu to go skoroszytu
                            'kopiuję zakres A1:B5 do arkusza zbiorczego
                            .Range("K1:L4").Copy Destination:=Workbooks("start.xls").Worksheets(2).Range("B" & wiersz)
                            'zwiększam wiersz o 4 - bo tyle miałem wierszy w kopiowanym zakresie
                            wiersz = wiersz + 4
                            End With ' tyle operacji na tym arkuszu
                            wbkSkoroszyt.Close False 'zamykam odnaleziony skoroszyt bez zapisywania zmian
                    Next i ' idź do następnego skoroszytu
            Else ' jeżeli nie znalazlem plików w podanej lokalizacji
                    MsgBox "Nie znaleziono zadnych plików" ' daję komunikat
            End If ' koniec możliwości odnoście znajdowania
      End With 'kończę pracę w obiektem FileSearch
     
    End Sub
    
    


    Thursday, October 13, 2011 9:14 AM
  • Set a reference to MS Scripting Runtime, and use

    Sub OperacjeHurtowe2()
        Dim objFSO As Scripting.FileSystemObject
        Dim objFolder As Scripting.Folder
        Dim colFiles As Scripting.Files
        Dim objfile As Scripting.File
        Dim iFile As Integer

        Dim wbkSkoroszyt As Workbook
        Dim i As Integer
        Dim wiersz As Long
        Dim sciezka As String
        Dim dato As String

        dato = Range("B3").Value    ' nazwa folderu z  data do pobrania danych
        ' okreslam sciezke szukania jako podkatalg dato katalogu gdzie znajduje sie skoroszyt Zbiorczy
        sciezka = ThisWorkbook.Path & "\" & dato
        wiersz = 2    ' zmienna okreslajaca biezacy wiersz w arkuszu gdzie zbieram dane

        Set objFSO = CreateObject("Scripting.FileSystemObject")
        Set objFolder = objFSO.GetFolder(sciezka)
        Set colFiles = objFolder.Files
        iFile = 0
        For Each objfile In colFiles
            If objfile.Type = "Microsoft Excel Worksheet" Then
                '            MergeDocument objfile.Path

                ' jezeli liczba znalezionych (i posortowanych przy okazji) jest wieksza od zero
                ' otwieram 1 odnaleziony skoroszyt (a w nastepnych obiegach petli  2,3 az do ilosci znalezionych)
                Set wbkSkoroszyt = Workbooks.Open(objfile.Path)
                'aktywuje ten skoroszyt
                wbkSkoroszyt.Activate
                'Wpisuje nazwe otwartego skoroszytu do arkusza zbiorczego jako nazwe dzialu (bez 4 koncowych znaków czyli bez .xls)
                Workbooks("start.xls").Worksheets(2).Range("A" & wiersz) = Mid(wbkSkoroszyt.Name, 1, Len(wbkSkoroszyt.Name) - 4)
                'przesuwam wiersz o jeden
                'wiersz = wiersz + 1 '
                With wbkSkoroszyt.Worksheets(1)    ' w pierwszym arkuszu to go skoroszytu
                    'kopiuje zakres A1:B5 do arkusza zbiorczego
                    .Range("K1:L4").Copy Destination:=Workbooks("start.xls").Worksheets(2).Range("B" & wiersz)
                    'zwiekszam wiersz o 4 - bo tyle mialem wierszy w kopiowanym zakresie
                    wiersz = wiersz + 4
                End With    ' tyle operacji na tym arkuszu
                wbkSkoroszyt.Close False    'zamykam odnaleziony skoroszyt bez zapisywania zmian
                iFile = iFile + 1
            End If
        Next
        If iFile = 0 Then
            MsgBox "Nie znaleziono zadnych plików"    ' daje komunikat
        End If    ' koniec mozliwosci odnoscie znajdowania

    End Sub


    HTH, Bernie
    Friday, October 14, 2011 5:48 PM
  • Almost 4 Years, but I like to thanks you Jean-Paul, your solution work with my case...

    Best Regards,
    AnuG
    absetiawan
    Tuesday, October 25, 2011 11:05 AM
  • Still an issue for me, after 6 years.

    I've been trying some of the code that's been posted, but I really have no idea what I'm doing beyond 'copy and paste, hit run'.  Can someone help with the below code?

    'Code goes in a standard module

     '''''MUST SET REFERENCE to WINDOWS SCRIPT HOST OBJECT MODEL''''''''''''

     

    Option Explicit

     

    Sub PopulateDirectoryList()

         'dimension variables

        Dim objFSO As FileSystemObject, objFolder As Folder

        Dim objFile As File, strSourceFolder As String, x As Long, i As Long

        Dim wbNew As Workbook, wsNew As Worksheet

        

        ToggleStuff False 'turn of screenupdating

        

        Set objFSO = New FileSystemObject 'set a new object in memory

        strSourceFolder = BrowseForFolder 'call up the browse for folder routine

        If strSourceFolder = "" Then Exit Sub

        

        Workbooks.Add 'create a new workbook

        

        Set wbNew = ActiveWorkbook

        Set wsNew = wbNew.Sheets(1) 'set the worksheet

        wsNew.Activate

         'format a header

        With wsNew.Range("A1:F1")

            .Value = Array("File", "Size", "Modified Date", "Last Accessed", "Created Date", "Full Path", "Size")

            .Interior.ColorIndex = 7

            .Font.Bold = True

            .Font.Size = 12

        End With

        

        With Application.FileSearch

            .LookIn = strSourceFolder 'look in the folder browsed to

            .FileType = msoFileTypeAllFiles 'get all files

            .SearchSubFolders = True 'search sub directories

            .Execute 'run the search

            

            For x = 1 To .FoundFiles.Count 'for each file found, by the count (or index)

                i = x 'make the variable i = x

                If x > 60000 Then 'if there happens to be more than multipls of 60,000 files, then add a new sheet

                    i = x - 60000 'set i to the right number for row placement below

                    Set wsNew = wbNew.Sheets.Add(after:=Sheets(wsNew.Index))

                    With wsNew.Range("A1:F1")

                        .Value = Array("File", "Parent Folder", "Full Path", "Modified Date", _

                        "Last Accessed", "Size")

                        .Interior.ColorIndex = 7

                        .Font.Bold = True

                        .Font.Size = 12

                    End With

                    

                End If

                On Error GoTo Skip 'in the event of a permissions error

                

                Set objFile = objFSO.GetFile(.FoundFiles(x)) 'set the object to get it's properties

                With wsNew.Cells(1, 1) 'populate the next row with the variable data

                    .Offset(i, 0) = objFile.Name

                    .Offset(i, 1) = Format(objFile.Size, "0,000") & " KB"

                    .Offset(i, 2) = objFile.DateLastModified

                    .Offset(i, 3) = objFile.DateLastAccessed

                    .Offset(i, 4) = objFile.DateCreated

                    .Offset(i, 5) = objFile.Path

                    

                End With

                 ' Next objFile

    Skip:

                 'this is in case a Permission denied error comes up or an unforeseen error

                 'Do nothing, just go to next file

            Next x

            wsNew.Columns("A:F").AutoFit

            

        End With

        

         'clear the variables

        Set objFolder = Nothing

        Set objFile = Nothing

        Set objFSO = Nothing

        Set wsNew = Nothing

        Set wbNew = Nothing

        

        ToggleStuff True 'turn events back on

    End Sub

    Sub ToggleStuff(ByVal x As Boolean)

        Application.ScreenUpdating = x

        Application.EnableEvents = x

    End Sub

     

     

    Function BrowseForFolder(Optional OpenAt As Variant) As Variant

         '''Code from kpuls, www.VBAExpress.com..portion of Knowledge base submission

         ''www.codeguru.com

        

        Dim ShellApp As Object

        Set ShellApp = CreateObject("Shell.Application"). _

        BrowseForFolder(0, "Please choose a folder", 0, OpenAt)

        

        On Error Resume Next

        BrowseForFolder = ShellApp.self.Path

        On Error GoTo 0

        

        Set ShellApp = Nothing

        

        Select Case Mid(BrowseForFolder, 2, 1)

        Case Is = ":"

            If Left(BrowseForFolder, 1) = ":" Then GoTo Invalid

        Case Is = "\"

            If Not Left(BrowseForFolder, 1) = "\" Then GoTo Invalid

        Case Else

            GoTo Invalid

        End Select

        Exit Function

        

    Invalid:

        

        

        ToggleStuff True

    End Function

    Thanks in advance!

    Thursday, July 05, 2012 3:56 PM
  • The code works fine. It makes a list of all the files in a selected folder and any subfolders.  What do you want to do with it?

    HTH, Bernie

    Friday, July 06, 2012 3:30 PM
  • It's a great code for Excel 2000, but I was receiving an 'object not found' error relating to Application.FileSearch in Excel 2007.  Just found this adaptation of the code, which is working for me now.

    'Code goes in a standard module
    '''''MUST SET REFERENCE to WINDOWS SCRIPT HOST OBJECT MODEL''''''''''''

    Option Explicit

    Sub PopulateDirectoryList()
         'dimension variables
        Dim objFSO As FileSystemObject, objFolder As Folder
        Dim objFile As File, strSourceFolder As String, x As Long, i As Long
        Dim wbNew As Workbook, wsNew As Worksheet
         
        ToggleStuff False 'turn of screenupdating
         
        Set objFSO = New FileSystemObject 'set a new object in memory
        strSourceFolder = BrowseForFolder 'call up the browse for folder routine
        If strSourceFolder = "" Then Exit Sub
         
        Workbooks.Add 'create a new workbook
         
        Set wbNew = ActiveWorkbook
        Set wsNew = wbNew.Sheets(1) 'set the worksheet
        wsNew.Activate
         'format a header
        With wsNew.Range("A1:F1")
            .Value = Array("File", "Size", "Modified Date", "Last Accessed", "Created Date", "Full Path", "Size")
            .Interior.ColorIndex = 7
            .Font.Bold = True
            .Font.Size = 12
        End With
         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, strSourceFolder, "*", True)
    ' Print list to immediate debug window and as a message window
    x = 1
    For Each FileNameWithPath In ListOfFilenamesWithParh ' cycle for list(collection) processing
    'for each file found, by the count (or index)
                i = x 'make the variable i = x
                If x > 60000 Then 'if there happens to be more than multipls of 60,000 files, then add a new sheet
                    i = x - 60000 'set i to the right number for row placement below
                    Set wsNew = wbNew.Sheets.Add(after:=Sheets(wsNew.Index))
                    With wsNew.Range("A1:F1")
                        .Value = Array("File", "Parent Folder", "Full Path", "Modified Date", _
                        "Last Accessed", "Size")
                        .Interior.ColorIndex = 7
                        .Font.Bold = True
                        .Font.Size = 12
                    End With
                     
                End If
                On Error GoTo Skip 'in the event of a permissions error
                 
                Set objFile = objFSO.GetFile(FileNameWithPath) 'set the object to get it's properties
                With wsNew.Cells(1, 1) 'populate the next row with the variable data
                    .Offset(i, 0) = objFile.Name
                    .Offset(i, 1) = Format(objFile.Size, "0,000") & " KB"
                    .Offset(i, 2) = objFile.DateLastModified
                    .Offset(i, 3) = objFile.DateLastAccessed
                    .Offset(i, 4) = objFile.DateCreated
                    .Offset(i, 5) = objFile.Path
                     
                End With
                 ' Next objFile
    Skip:
                 'this is in case a Permission denied error comes up or an unforeseen error
                 'Do nothing, just go to next file
            x = x + 1
            On Error Resume Next
            wsNew.Columns("A:F").AutoFit
             
     Next FileNameWithPath
    ' Print to immediate debug window and message if no file was found
    If ListOfFilenamesWithParh.Count = 0 Then

    MsgBox "No file was found !"
    End If


           
         'clear the variables
        Set objFolder = Nothing
        Set objFile = Nothing
        Set objFSO = Nothing
        Set wsNew = Nothing
        Set wbNew = Nothing
         
        ToggleStuff True 'turn events back on
    End Sub
    Sub ToggleStuff(ByVal x As Boolean)
        Application.ScreenUpdating = x
        Application.EnableEvents = x
    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

    Function BrowseForFolder(Optional OpenAt As Variant) As Variant
         '''Code from kpuls, www.VBAExpress.com..portion of Knowledge base submission
         ''www.codeguru.com
         
        Dim ShellApp As Object
        Set ShellApp = CreateObject("Shell.Application"). _
        BrowseForFolder(0, "Please choose a folder", 0, OpenAt)
         
        On Error Resume Next
        BrowseForFolder = ShellApp.self.Path
        On Error GoTo 0
         
        Set ShellApp = Nothing
         
        Select Case Mid(BrowseForFolder, 2, 1)
        Case Is = ":"
            If Left(BrowseForFolder, 1) = ":" Then GoTo Invalid
        Case Is = "\"
            If Not Left(BrowseForFolder, 1) = "\" Then GoTo Invalid
        Case Else
            GoTo Invalid
        End Select
        Exit Function
         
    Invalid:
         
         
        ToggleStuff True
    End Function

    Friday, July 06, 2012 3:37 PM
  • Here is one example of Bogdan's code with practical solution.

    Private Sub CommandButton1_Click()
    'This is modification on Bogdan code as replacement of "Aplication.FileSearch" which doesn't work in Office 2007+.
    'This code open only *.xls file in folder on specified path,  it collects some data and then closes it without saving
    '(for automation of file "open_close" procedure).
    'It can be used to import (collect) data from other xls file which can be selected
    'according to various key such as date of modification, file name etc..
    'Remarks: It seams that this code works much slower that code made with "Aplication.FileSearch" which I use in Office 2003.


    Dim fs, f, fc, s, f1
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.GetFolder("d:/example1/")  'Folder Path
    Set fc = f.Files

    k = 1   'Initial value for counter
           
    For Each f1 In fc


        If f1.Type <> "XLS File" Then GoTo labelEnd     'Only specific file type will be included
       
        datum = Val(f1.DateCreated) 'Date of Modified
        m = Month(datum)    'File Month
        d = Day(datum)      'File Day
        y = Year(datum)     'File Year
        'Here can be written code for file selection as key of selection.
        'e.g. according to file modified date.
        'So, only file of desired date "From_To" date are to be included.......
          
           Set f1 = Workbooks.Open(f1)
            'Example for practical solution
            Sheet1.Cells(k, 1) = f1.Name     'Just for example......
            k = k + 1
        f1.Saved = True     'To avoid Save verification before file closing
        f1.Close                 'Close active file
    labelEnd:
    Next

    End Sub

    'Thanks Bogdan

    'PedjaR

    Friday, January 04, 2013 8:39 AM