Link to home
Create AccountLog in
Avatar of daviddiebel
daviddiebel

asked on

List Excel Files in a Folder

I am trying to develop a macro create a list of all Excel files (not other files types) in a specified folder, including in any subfolders.

It would be ideal if the information would populate two columns in the active workbook running the macro: one column would list the Excel file names, and the other would list the corresponding file path.

I appreciate  any assistance with this!  Thank you.
Avatar of Dirk Haest
Dirk Haest
Flag of Belgium image

Code found at http://www.ozgrid.com/forum/showthread.php?t=65530

Sub ListAllFiles() 
    Dim fs As FileSearch, ws As Worksheet, i As Long 
    Set fs = Application.FileSearch 
    With fs 
        .SearchSubFolders = False ' set to true if you want sub-folders included
        .FileType = msoFileTypeAllFiles 'can modify to just Excel files eg with msoFileTypeExcelWorkbooks
        .LookIn = "C:\" 'modify this to where you want to serach
        If .Execute > 0 Then 
            Set ws = Worksheets.Add 
            For i = 1 To .FoundFiles.Count 
                ws.Cells(i, 1) = .FoundFiles(i) 
            Next 
        Else 
            MsgBox "No files found" 
        End If 
    End With 
End Sub 

Open in new window

you need only excel file name ...try this

 
Dim Test, sPath As String
Dim Folder, oFSO As Object
On Error Resume Next
 
Set wbCodeBook = ThisWorkbook
 
sPath = "Your Path"
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set Folder = oFSO.GetFolder(sPath)
 
With Application.FileSearch
    .NewSearch
     'Change path to suit
    .LookIn = Folder
    .FileType = msoFileTypeExcelWorkbooks
    .SearchSubFolders = False
    .Filename = "*.xls"
    If .Execute > 0 Then 'Workbooks in folder
        For lCount = 1 To .FoundFiles.Count 'Loop through all.
             'This next line should get you the filename of all excel workbooks int he directory
            Workbooks.Name(Filename:=.FoundFiles(lCount), UpdateLinks:=0)
        Next lCount
    End If
End With

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

Sub ListAllXLSFiles()
    Dim lCount As Long
    Dim wbResults As Workbook
    Dim wbCodeBook As Workbook
     
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.EnableEvents = False
     
    On Error Resume Next
     
    Set wbCodeBook = ThisWorkbook
     
    With Application.FileSearch
        .NewSearch
         'Change path to suit
        .LookIn = "C:\Documents and Settings\"
        .FileType = msoFileTypeExcelWorkbooks
         'change filename to suit
        .Filename = "*.xls"
         
        If .Execute > 0 Then 'Workbooks in folder
            For lCount = 1 To .FoundFiles.Count 'Loop through all.
                 'paste filenames to activesheet starting in cell A1
                ActiveSheet.Cells(lCount, 1).Value = .FoundFiles(lCount)
            Next lCount
        End If
    End With
     
    On Error Goto 0
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Application.EnableEvents = True
End Sub

http://www.ozgrid.com/forum/showthread.php?t=75421
ASKER CERTIFIED SOLUTION
Avatar of dlmille
dlmille
Flag of United States of America image

Link to home
membership
Create an account to see this answer
Signing up is free. No credit card required.
Create Account
Avatar of daviddiebel
daviddiebel

ASKER

Thank you!