Application.filesearch Replacement For Office 2007

[jolivanes]

In the following thread, richphillips wonders about Application.Filesearch

http://www.ozgrid.com/forum/showthread.php?t=68191

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.