Results 1 to 4 of 4

Thread: Search Directories to List Files VBA

  1. #1
    Administrator Admin's Avatar
    Join Date
    Mar 2011
    Posts
    1,122
    Rep Power
    10

    Lightbulb Search Directories to List Files VBA

    Hi All,

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

    Code:
    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..

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

  2. #2
    Senior Member
    Join Date
    Apr 2011
    Posts
    190
    Rep Power
    13
    You can also use the filedialog method.

    Code:
    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"

    Code:
    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
    Last edited by Rasm; 10-28-2011 at 06:18 AM.
    xl2007 - Windows 7
    xl hates the 255 number

  3. #3
    Administrator Admin's Avatar
    Join Date
    Mar 2011
    Posts
    1,122
    Rep Power
    10
    Thanks Rasm
    Cheers !

    Excel Range to BBCode Table
    Use Social Networking Tools If You Like the Answers !

    Message to Cross Posters

    @ Home - Office 2010/2013/2016 on Win 10 (64 bit); @ Work - Office 2016 on Win 10 (64 bit)

  4. #4
    Jimmyc
    Guest
    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
    Last edited by Jimmyc; 04-15-2014 at 08:55 PM.

Similar Threads

  1. Search and remove values ​​from a list
    By PcMax in forum Excel Help
    Replies: 4
    Last Post: 04-14-2013, 08:39 PM
  2. List of files in chronological order
    By Rasm in forum Excel Help
    Replies: 2
    Last Post: 11-12-2012, 10:16 PM
  3. VBA Function to Search in Array
    By Admin in forum Excel and VBA Tips and Tricks
    Replies: 0
    Last Post: 04-10-2012, 11:34 AM
  4. Get Name List of All Open Workbook Files
    By princ_wns in forum Excel Help
    Replies: 5
    Last Post: 04-07-2012, 12:18 PM
  5. List Of All Files In A Folder
    By Excel Fox in forum Excel Help
    Replies: 2
    Last Post: 10-27-2011, 09:10 AM

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •