Get the list of files from a folder based on cell A1

[Lakabi]

Hi all
I would like to have to have the list of files from folder "X" including subfolders ( the folder is on the network), in column B, and from folder "Y" including subfolders ( the folder is on the network) in column C based on the criteria in cell A1. I am looking for all files which names starts with the string entered in A1. Ex. if A1= 12345, then list all files from folder X and folder Y, which file names start with 12345 (ex file "12345 abc.pdf"). Perhaps list only the file names as hyperlinks. Also I would need the list to update soon as the value or string in A1 is changed. Using Excel 2003.
Thanks in advance.

 

[Lakabi]

This is what I found so far:

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 = "a1" Then FileFilter = "*.*" ' all files
With Application.FileSearch
.NewSearch
.LookIn = CurDir
.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

Sub TestCreateFileList()
Dim FileNamesList As Variant, i As Integer
'ChDir "C:\My Documents"
' activate the desired startfolder for the filesearch
FileNamesList = CreateFileList("*.*", False)
' performs the filesearch, includes any subfolders
' present the result
Range("A:A").ClearContents
For i = 1 To UBound(FileNamesList)
Cells(i + 1, 1).Formula = FileNamesList(i)
Next i
End Sub

It does give me the list of files in "My Documents" but I do not know how to link it to cell A1 as a lookup filter or as a criteria.

Any suggestions?

 

[Ruddles]

Is it:-

FileNamesList = CreateFileList(Range(A1").Value & "*.*", False)

 

[Lakabi]

I got syntax error, on the new line.

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 = "b1" Then FileFilter = "*.*" ' all files
With Application.FileSearch
.NewSearch
.LookIn = CurDir
.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

Sub TestCreateFileList()
Dim FileNamesList As Variant, i As Integer
'ChDir "C:\My Documents"
' activate the desired startfolder for the filesearch
FileNamesList = CreateFileList(Range(A1").Value & "*.*", False)
' performs the filesearch, includes any subfolders
' present the result
Range("A:A").ClearContents
For i = 1 To UBound(FileNamesList)
Cells(i + 1, 1).Formula = FileNamesList(i)
Next i
End Sub

I used it on the wrong line?
Thanks

 

[Ruddles]

Sorry, I missed a quote:-

FileNamesList = CreateFileList(Range([COLOR=red][B]"[/B][/COLOR]A1").Value & "*.*", False)

 

[Lakabi]

Works perfect. Thank you.
Of course I had to change the reference cell from A1 to B1, since "Range("A:A").ClearContents" caused a little hiccup.
The only two things left, how to extend the listing of files into the subfolders,
and how to update the list automatically, once the string or value in the reference cell changes.
I appreciate all the help.

 

[Lakabi]

Can somebody please help me why the list of files does not include the files from the sub folders?

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
With Application.FileSearch
.NewSearch
.LookIn = CurDir
.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

Sub TestCreateFileList()
Dim FileNamesList As Variant, i As Integer
'ChDir "C:\My Documents"
' activate the desired startfolder for the filesearch
FileNamesList = CreateFileList(Range("B1").Value & "*.*", False)
' performs the filesearch, includes any subfolders
' present the result
Range("A:A").ClearContents
For i = 1 To UBound(FileNamesList)
Cells(i + 1, 1).Formula = FileNamesList(i)
Next i
End Sub

Thank you.

 

[Ralajer]

The second argument in the function call is what determines if the subfolders should included.

To Exclude Subfolder

FileNamesList = CreateFileList(Range("A1").Value & "*.*", [COLOR="Red"]False[/COLOR])

To Include Subfolder

FileNamesList = CreateFileList(Range("A1").Value & "*.*", [COLOR="blue"]True[/COLOR])

 

[Lakabi]

Thank you.
It is working, but now the criteria from cell B1 (changed it from A1) does not work. Ex. enter 529 or letter d in B1 and it lists all the files. If I changed it back to FALSE, it will list the first instance ex 529 then a few random files. (there are multiple files starts with 529 in the same folder)
Here is what I have now:


Function CreateFileList(FileFilter As String, _
IncludeSubfolders 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
With Application.FileSearch
.NewSearch
.LookIn = CurDir
.FileName = FileFilter
.SearchSubFolders = IncludeSubfolders
.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

Sub TestCreateFileList()
Dim FileNamesList As Variant, i As Integer
ChDir "C:\Documents and Settings\User\My Documents\"
' activate the desired startfolder for the filesearch
FileNamesList = CreateFileList(Range("B1").Value & "*.*", True)
' performs the filesearch, includes any subfolders
' present the result
Range("A:A").ClearContents
For i = 1 To UBound(FileNamesList)
Cells(i + 1, 1).Formula = FileNamesList(i)
Next i
End Sub

What I am doing wrong?

 

[Ralajer]

Application.FileSearch was deprecated and not included after Excel 2003 and I have 2010. So sadly I can't test or worth yet use it but looking through it I don't see anything jumping out at me.

Also, please surround code with code tags

...code...

to preserve indentation which makes code easier to read and more likely to get a response. Either by typing them or pressing the # in post editor's toolbar..

The below is just a repost of the above code with the inclusion of code tags and indentation for the convenience of other contributors.

Function CreateFileList(FileFilter As String, _
                         IncludeSubfolders As Boolean) As Variant
    ' returns the full filename for files matching
    ' the filter criteria in the current folder
    Dim FileList() As String
    Dim FileCount As Long
    CreateFileList = ""
    
    Erase FileList
    
    If FileFilter = "" Then FileFilter = "*.*" ' all files
    With Application.FileSearch
        .NewSearch
        .LookIn = CurDir
        .Filename = FileFilter
        .SearchSubFolders = IncludeSubfolders
        .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

Sub TestCreateFileList()
    Dim FileNamesList As Variant, i As Integer
    
    ChDir "C:\Documents and Settings\User\My Documents\"
    
    ' activate the desired startfolder for the filesearch
    
    FileNamesList = CreateFileList(Range("B1").Value & "*.*", True)
    ' performs the filesearch, includes any subfolders
    ' present the result
    
    Range("A:A").ClearContents
    
    For i = 1 To UBound(FileNamesList)
        Cells(i + 1, 1).Formula = FileNamesList(i)
    Next i
    
End Sub