Search Directories to List Files VBA

[Admin]

Hi All,

Here is a method to list files from a directory (Including sub directory). I hope you would find this useful.

Function SearchFiles(ByVal FolderToSearch As String, Optional ByVal Extn As String = "xls", _
                                        Optional ByVal SearchSubFolders As Boolean = False)
                                            
    
    '//Developed by       : ExcelFox.com
    
    If Right$(FolderToSearch, 1) <> "\" Then FolderToSearch = FolderToSearch & "\"
    If Not CBool(Len(Dir(FolderToSearch, vbDirectory))) Then Exit Function
    
    Dim objFSO      As Object
    Dim objItem     As Object
    Dim objFldr     As Object
    Dim objFolder   As Object
    Dim FilesList() As String
    Dim CountFiles  As Long
    Dim strFileName As String
    
    If Left$(Extn, 1) <> "." Then Extn = "." & Extn
    Extn = Replace(Extn, "*", "")
    Select Case SearchSubFolders
        Case True
            Set objFSO = CreateObject("scripting.filesystemobject")
            Set objFolder = objFSO.getfolder(FolderToSearch)
            
            For Each objItem In objFolder.Files
                If InStr(1, LCase$(Mid$(objItem.Name, InStrRev(objItem.Name, "."))), LCase$(Extn)) Then
                    CountFiles = CountFiles + 1
                    ReDim Preserve FilesList(CountFiles)
                    FilesList(CountFiles) = objItem
                End If
            Next
            If objFolder.subfolders.Count Then
                For Each objFldr In objFolder.subfolders
                    For Each objItem In objFldr.Files
                        If InStr(1, LCase$(Mid$(objItem.Name, InStrRev(objItem.Name, "."))), LCase$(Extn)) Then
                            CountFiles = CountFiles + 1
                            ReDim Preserve FilesList(CountFiles)
                            FilesList(CountFiles) = objItem
                        End If
                    Next
                Next
            End If
            If CountFiles Then SearchFiles = FilesList
        Case False
            strFileName = Dir(FolderToSearch & "*" & Extn)
            Do While Len(strFileName)
                CountFiles = CountFiles + 1
                ReDim Preserve FilesList(CountFiles)
                FilesList(CountFiles) = FolderToSearch & strFileName
                strFileName = Dir()
            Loop
            If CountFiles Then SearchFiles = FilesList
    End Select
    
    Set objFldr = Nothing
    Set objFolder = Nothing
    Set objFSO = Nothing
    
End Function

and call the function like..

Sub kTest()
Dim a
a = SearchFiles("C:\MyFolder\", ".xls*", 1)
MsgBox Join(a, vbLf)
End Sub

[Rasm]

You can also use the filedialog method.

Function GetFolder(strPath As String) As String
    Dim fldr As FileDialog
    Dim sItem As String
    Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
    With fldr
        .Title = "Select a Folder"
        .AllowMultiSelect = False
        .InitialFileName = strPath
        If .Show <> -1 Then GoTo NextCode
        sItem = .SelectedItems(1)
    End With
NextCode:
    GetFolder = sItem
    Set fldr = Nothing
End Function

where

FileSpec = TextfilePath.Text & "\*.XLS"

Function GetFileList(FileSpec As String, FileArray() As Variant) As Variant
    Dim FileCount As Integer
    Dim FileName As String
    On Error GoTo NoFilesFound
    FileCount = 0
    FileName = Dir(FileSpec)
    If FileName = "" Then GoTo NoFilesFound
'   Loop until no more matching files are found
    Do While FileName <> ""
        FileCount = FileCount + 1
        ReDim Preserve FileArray(1 To FileCount)
        FileArray(FileCount) = FileName
        FileName = Dir()
    Loop
    GetFileList = FileArray
    Exit Function
'   Error handler
NoFilesFound:
    GetFileList = False
End Function

[Admin]

Thanks Rasm

[Jimmyc]

I am just learning vba; I am using Excel 2010 with Win7 Professional. I copied the code in the first Admin post to two modules--but when I run the code (call the function) I get a compile error--"invalid outside procedure" on the FoldertoSearch in the first line of the code. Thanks. JimC