Loop through every file in folder and list all sheet names

[Corgan]

Hi

I was wondering if anyone had any code to loop through every file in a folder and list the file name along with every sheet name in that file? I'm using Excel 2007.

Thanks in advance

 

[BiocideJ]

This is a relatively straightforward approach that should work for Excel 2007 without a problem.
Just change C:\Temp\ to whatever folder you want and it will put the folder tree in the active worksheet.
NOTE: Make sure a blank worksheet is active before running the macro or it will overwrite whatever is there.

Sub FolderCrawler()
FileType = "*.xls*"     'The file type to search for
FilePath = "C:\Temp\"   'The folder to search
OutputRow = 2   'The first row of the active sheet to start writing to

ThisWorkbook.ActiveSheet.Range("A" & OutputRow) = FilePath & FileType
OutputRow = OutputRow + 1
Curr_File = Dir(FilePath & FileType)
Do Until Curr_File = ""
    Set FldrWkbk = Workbooks.Open(FilePath & Curr_File, False, True)
    ThisWorkbook.ActiveSheet.Range("A" & OutputRow) = Curr_File
    ThisWorkbook.ActiveSheet.Range("B" & OutputRow).ClearContents   'Clear any previous values
    OutputRow = OutputRow + 1
    
    For Each Sht In FldrWkbk.Sheets
        ThisWorkbook.ActiveSheet.Range("B" & OutputRow) = Sht.Name
        ThisWorkbook.ActiveSheet.Range("A" & OutputRow).ClearContents 'Clear any previous values
        OutputRow = OutputRow + 1
    Next Sht
    FldrWkbk.Close SaveChanges:=False
    Curr_File = Dir
Loop
Set FldrWkbk = Nothing
ThisWorkbook.ActiveSheet.Range("A" & OutputRow) = "---END OF FOLDER---"
End Sub

You could potentially get more creative with this and also return whether the sheets are hidden or not by using the Sht.Visible flag and putting that in column C, but I figured I wouldn't include that since you didn't ask. By default this macro returns all sheets (visible AND hidden)

 

[brawnystaff]

Can you modify the VBA to allow the user to select the folder to be looped through?

 

[BiocideJ]

It is already set up to allow that.
Simply change

FilePath = "C:\Temp\" 'The folder to search

to

FilePath = "{your path here}<YOUR path>"

and you are set.

 

[BiocideJ]

Actually, after posting and thinking about your request I realized what you meant. You want to be able to DYNAMICALLY choose the folder.
That shouldn't be a problem with the FileDialog option. I post it below and as far as I can see it should work perfectly.

Sub FolderCrawler()
FileType = "*.xls*"     'The file type to search for
With Application.FileDialog(msoFileDialogFolderPicker)
    .InitialFileName = ThisWorkbook.Path
    .AllowMultiSelect = False
    If .Show = -1 Then
        FilePath = .SelectedItems(1) & "\"
    Else
        Exit Sub    'Cancel was pressed
    End If
    
End With
OutputRow = 2   'The first row of the active sheet to start writing to
ThisWorkbook.ActiveSheet.Range("A" & OutputRow) = FilePath & FileType
OutputRow = OutputRow + 1
Curr_File = Dir(FilePath & FileType)
Do Until Curr_File = ""
    Set FldrWkbk = Workbooks.Open(FilePath & Curr_File, False, True)
    ThisWorkbook.ActiveSheet.Range("A" & OutputRow) = Curr_File
    ThisWorkbook.ActiveSheet.Range("B" & OutputRow).ClearContents   'Clear any previous values
    OutputRow = OutputRow + 1
    
    For Each Sht In FldrWkbk.Sheets
        ThisWorkbook.ActiveSheet.Range("B" & OutputRow) = Sht.Name
        ThisWorkbook.ActiveSheet.Range("A" & OutputRow).ClearContents 'Clear any previous values
        OutputRow = OutputRow + 1
    Next Sht
    FldrWkbk.Close SaveChanges:=False
    Curr_File = Dir
Loop
Set FldrWkbk = Nothing
ThisWorkbook.ActiveSheet.Range("A" & OutputRow) = "---END OF FOLDER---"
End Sub

 

[backbone10]

Hi, i have see that this is an very old thread, but this really works perfectly ..
Ist it possible to change the code in that way, that also subdirectories will be searched for worksheets (recursiv) ?

THX

bb10