Thread: "application.FileSearch" Excel 2007 update

Hi everyone!

I have a piece of code that was written by someone else (namely Phil_V, from these very forums) that only works in versions of Excel before 2007. I was just hoping that someone could update the code for me?

I know it's a lot to ask, but I simply don't have the expertise to do it myself I really appreciate any help received.

The code that needs updating is as follows:

Code:

Private Sub Find_Newest_Files(ByRef filelist() As Variant)
' Will use the worksheet passed as 'filelist_ws' to compile a list of the newest files in the current directory

Dim l_count As Long
Dim filename As String, place_n_item As String, last_place_n_item As String
Dim fl_index As Long

' Search for all the .txt files files in the current directory that match the filename pattern
With Application.FileSearch   <---- This is the part that doesn't work in 2007!!
    .NewSearch
    .LookIn = ThisWorkbook.Path
    .filename = "*-*-*.txt"
    If .Execute(SortBy:=msoSortByFileName, SortOrder:=msoSortOrderDescending) > 0 Then
        
        ' Resize the array to the largest we will need it
        ReDim filelist(1 To .FoundFiles.Count)
        fl_index = 0
        
        ' Cycle through each of the files that were found
        For l_count = 1 To .FoundFiles.Count
            
            ' Extract the filename from the foundfile path information
            filename = Mid(.FoundFiles(l_count), InStrRev(.FoundFiles(l_count), "\") + 1)
            ' extract the place and item from the filename
            place_n_item = Left(filename, InStrRev(filename, "-") - 1)
            
            ' If the place and item are the same as the previous file then this is older, otherwise it's a new file _
              and should be added to our filelist array
            If place_n_item <> last_place_n_item Then
                last_place_n_item = place_n_item
                fl_index = fl_index + 1
                filelist(fl_index) = .FoundFiles(l_count)
            End If
        Next
        ' If we added files to the filelist, then resize the list now to be only as big as we need. _
          If we didn't add any files then return the first item in the array as 0.
        If fl_index > 0 Then
            ReDim Preserve filelist(1 To fl_index)
        Else
            filelist = [{0}]
        End If
    Else
        filelist = [{0}]
    End If
End With
End Sub

Hi,

Application.FileSearch is not in Excel 2007.

Try to use FileScripting instead of FileSearch Method.

eg,

Code:

 Dim fs
 Set fs = CreateObject("Scripting.FileSystemObject")
 
 With fs
  ' do ur stuff here
 End with

Did you state the Excel version in your original question? This is why it is important to do so. There is no Application.Filesearch in Excel 2007.

http://excel2007tips.blogspot.com/

I don't think it was mentioned originally in the Q that Dan was using 2007, but he does have it filled in in his profie, (top right of his posts), and I just didn't notice it until I'd already written the code.
I'll have a look at correcting the code using File Scripting instead Dan, but it will be likely Sunday before I get a chance now

Phil

The link contains alternative code, that I believe will be backwards compatible.

Ok, so working from Roy's link and a few other sources dotted around the net I have rewritten a section of the code. I have written my own 'FileSearch' function that should work under Excel 2007 to replace the Application.FileSearch, (code below). It doesn't have all the functionality, in that it won't (currently) search subfolders, but you don't need it to for what you require.

I have also made a few other changes to the code that were neccasary to allow this new function to fit in.

Revised workbook (from based from the original thread) attached, FileSearch code below, (already in the workbook):

Code:

Function FilePathSearch2007(ByRef found_files() As Variant, path_to_search As String, Optional file_filter As String = "*.*", Optional sorttype As XlSortOrder = xlAscending) As Boolean
' Will search for files matching the pattern in path_to_search.
' If files are found then they are placed into the dynamic array 'found_files' passed to the function, and TRUE is returned
' If no files are found then FALSE is returned
Dim filename As String
Dim tempfile As String
Dim index1 As Long, index2 As Long
Dim index As Long

' If not trailing "\" then add one
If Right(path_to_search, 1) <> "\" Then path_to_search = path_to_search & "\"

filename = Dir(path_to_search & file_filter)
If filename = "" Then
    FilePathSearch2007 = False
    Exit Function
End If
' Size the found_array so that we 'should' get all the results in
ReDim found_files(1 To 100)
index = 1
found_files(index) = path_to_search & filename
Do
    filename = Dir
    If filename = "" Then Exit Do
    If index Mod 100 = 0 Then ReDim Preserve found_files(1 To index + 100)
    index = index + 1
    found_files(index) = path_to_search & filename
Loop
ReDim Preserve found_files(1 To index)

'Sort it
For index1 = 1 To UBound(found_files)
    For index2 = index1 To UBound(found_files)
        tempfile = found_files(index1)
        Select Case sorttype
            Case xlAscending
                If tempfile > found_files(index2) Then
                    found_files(index1) = found_files(index2)
                    found_files(index2) = tempfile
                End If
            Case xlDescending
                If tempfile < found_files(index2) Then
                    found_files(index1) = found_files(index2)
                    found_files(index2) = tempfile
                End If
        End Select
    Next
Next
FilePathSearch2007 = True
End Function

As usual, any questions or problems please do ask

Oh, and if it works let me know that too please

Hi Dan,

Firstly please let me say that rewards are not neccasary. I do not do this is search of rewards, but to help other people and hopefully give back something to the community that I have used to learn my VBA knowledge from

Now onto the job at hand

The reason the datacore objects were having an issue was because of how I processed the strings.
A standard file name was like this:

Code:

Heimatar-Isogen-2009.07.02 173049.txt

So I used the '-' as delimiters, taking the 'location' to be all the text up to the first occurance of '-', and the item to be the text from that position up to the next occurance of '-'.
Of course once it then had a filename of the datacore type it missed the end of the item as the item name contained a '-':

Code:

Heimatar-Datacore - Rocket Science-2009.07.05 201658.txt

I have now altered the code to look for the first occurance of '-' in the text, and have the 'location' as everything before that.
Then look BACKWARDS through the text for the first occurance of '-' in that direction, and then have the 'item' as everything between those 2 points.
Hopefully that will sort out any issues you were having.

I have also added a progress panel to try and avoid that 'feeling of doom' when the macro is taking it's time to run

Does every file get updated every day, or is it possible there might only be 1 or 2 new files each day?
I ask because at the moment the macro blanks the summary page, then imports the data from the most recent version of each file, which is fine if the majority of files have changed, however it could get tedious if the majoriity of the files haven't changed, and yet we are throwing away perfectly valid data and then spending time reimporting it. In that case I could add a 'logging' feature to the workbook so that it would remember which files it had already imported, and then only import those that are newer than the ones it has already done, (if that makes sense!).
Of course there is no point in me adding this functionality if most of the files will be updated most times before the macro is run, as it will then be updating from every file anyway :P

Let me know how you get on with this new version