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