Application.filesearch Replacement For Office 2007

[jolivanes]

In the following thread, richphillips wonders about Application.Filesearch

Application.filesearch In Office 2007

There was no answer to his question.

Is there a replacement for this? I have several macros that use Application.Filesearch
and I would like it to work not only with Excel 2003 but also with Excel 2007.

This is the function

Function CreateFileList(FileFilter As String, _ 
    IncludeSubFolder As Boolean) As Variant 
     ' returns the full filename for files matching
     ' the  filter criteria in the current folder
    Dim FileList() As String, FileCount As Long 
    CreateFileList = "" 
    Erase FileList 
    If FileFilter = "" Then FileFilter = "*.*" ' all files
    Debug.Print CurDir 
    strFolder = BrowseForFolderShell(, , , 0) 
    If strFolder = "" Then 
         MsgBox "You Cancelled" 
        Exit Function 
    End If 
    With Application.FileSearch 
    .NewSearch 
    .LookIn = strFolder 
    .fileName = FileFilter 
    .SearchSubFolders = IncludeSubFolder 
    .FileType = msoFileTypeAllFiles 
    If .Execute(SortBy:=msoSortByFileName, _ 
    SortOrder:=msoSortOrderAscending) = 0 Then Exit Function 
    Redim FileList(.FoundFiles.Count) 
    For FileCount = 1 To .FoundFiles.Count 
        FileList(FileCount) = .FoundFiles(FileCount) 
    Next FileCount 
    .FileType = msoFileTypeExcelWorkbooks ' reset filetypes
End With 
CreateFileList = FileList 
Erase FileList 
End Function 

Thanks and regards.

John

[jolivanes]

After a few days it should be OK to BUMP.
Thanks

[royUK]

See this

[RichardSchollar]

Hi John

Filesearch has indeed been removed but the (very) old Dir remains, so you can use this instead, an example of which follows:

Sub testit() 
    myvar = FileList("C:\") 
    For i = LBound(myvar) To UBound(myvar) 
        Debug.Print myvar(i) 
    Next 
End Sub 
 
 Function FileList(fldr As String, Optional fltr As String = "*.*") As Variant 
    Dim sTemp As String, sHldr As String 
    If Right$(fldr, 1) <> "\" Then fldr = fldr & "\" 
    sTemp = Dir(fldr & fltr) 
    If sTemp = "" Then 
        FileList =  Split("No files found", "|") 'ensures an  array is returned
        Exit Function 
    End If 
    Do 
        sHldr = Dir 
        If sHldr = "" Then Exit Do 
        sTemp = sTemp & "|" & sHldr 
     Loop 
    FileList = Split(sTemp, "|") 
End Function 

This doesn't search subfolders but that functionality could no doubt be introduced. In the current spec you have to pass in the filepath to search.

Richard

EDIT: amended function so Do Loop doesn't error

[RichardSchollar]

For some reason I can't seem to edit my last message. I have changed the return type if no files are found (it simplifies the code):

Sub testit() 
    myvar = FileList("C:\Test3") 
    If TypeName(myvar) <> "Boolean" Then 
        For i = LBound(myvar) To UBound(myvar) 
            Debug.Print myvar(i) 
        Next 
    Else 
         MsgBox "No files found" 
    End If 
End Sub 
 
 Function FileList(fldr As String, Optional fltr As String = "*.*") As Variant 
    Dim sTemp As String, sHldr As String 
    If Right$(fldr, 1) <> "\" Then fldr = fldr & "\" 
    sTemp = Dir(fldr & fltr) 
    If sTemp = "" Then 
        FileList = False 
        Exit Function 
    End If 
    Do 
        sHldr = Dir 
        If sHldr = "" Then Exit Do 
        sTemp = sTemp & "|" & sHldr 
     Loop 
    FileList =  Split(sTemp, "|") 
End Function 

[ByTheCringe2]

You can edit your posts only for 1 hour after posting.

[RichardSchollar]

Ah that would expalin it! Thanks BTC2

[Dave Hawley]

Not too sure that it has been "removed" or M$ stuffed up and forgot to add it. Perhaps it will be added back after fixing the gazillion other bugs?

[jolivanes]

Parsnip, Roy, ByTheCringe2 and Dave, thanks for replying.
I put the suggested replacement code in from both Parsnip and Roy but I can't get things to work. Due to my ignorance of VB I have to say. I have looked and tried to understand the suggested code but I can't see where I need to change/add things to make it work as the file does in Excel 2003. I neglected to add the Sheet1 code to my first thread entry.
This is it.

Private Sub CommandButton1_Click() 
     
    Dim filenamelist() As Variant 
    filenameslist = CreateFileList("*.*", False) 
    If Not IsArray(filenameslist) Then 
         MsgBox "No files" 
        Exit Sub 
    End If 
     
    For i = 1 To UBound(filenameslist) 
        ActiveSheet. Cells(10 + i, 1).Value = filenameslist(i) 
    Next i 
End Sub 

I don't even know if you need it for the replies.

I have put Parsnip's and Roy's code in but because of my very limited VB knowledge, can't get it to work.
With Parsnip's code, I get either 'No files found" or nothing happens at all, depending on the changes I make.

In Roy's code it says "do something" but I don't even know what to enter at this point.

If someone has the time and would be willing to try the attached file in Excel 2003, he/she will see how it works and maybe tell me what to change where.

The code in the attached file is obviously not written by me.

Your help is greatly appreciated.

Thanks and regards.

John

[Dave Hawley]

Pasnips codes here works fine for me so long as I modify C:\Test3 to an extisting path on my PC.