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.

Dirk Haest

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

Pratima

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

dlmille

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

daviddiebel

ASKER

Thank you!