Sheet names from multiple files

[YasserKhalil]

Hello everyone
I have this code for Mr. Jindon that grabs sheet names from closed workbook

Sub Jindon()
    Dim fn As String, rs As Object, a() As String, N As Long, Temp As String
   
    fn = Application.GetOpenFilename("ExcelFiles,*.xls*")
    If fn = "False" Then Exit Sub
   
    With CreateObject("ADODB.Connection")
        .Open "Provider=Microsoft.ACE.OLEDB.12.0;" & "Data Source=" & fn & ";" & "Extended Properties='Excel 12.0'"
        Set rs = .OpenSchema(20, Array(Empty, Empty, Empty, "Table"))
        While Not (rs.EOF)
            Temp = rs("TABLE_NAME")
            N = N + 1: ReDim Preserve a(1 To N)
            a(N) = Left$(Temp, Len(Temp) - IIf(Temp Like "*'", 2, 1))
            rs.MoveNext
        Wend
       
        rs.Close
        .Close
    End With
   
    Cells(1).Resize(N).Value = Application.Transpose(a)
End Sub

I need to be able to select more files at the same time or specific folder that contains my files ..then extract all the sheet names from these files
At the same moment I need to excluded specific sheets from extraction process for example "Report" sheet and "Gooh" sheet
Hope it is clear

 

[YasserKhalil]

Any help in this topic please

 

[jindon]

Sub Jindon()
    Dim myDir As String, fn As String, rs As Object, a() As String, N As Long, Temp As String
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show Then myDir = .SelectedItems(1) & "\"
    End With
    If myDir = "" Then Exit Sub
    fn = Dir(myDir & "*.xls")
    Do While fn <> ""
        With CreateObject("ADODB.Connection")
            .Open "Provider=Microsoft.ACE.OLEDB.12.0;" & "Data Source=" & _
            myDir & fn & ";" & "Extended Properties='Excel 12.0'"
            Set rs = .OpenSchema(20, Array(Empty, Empty, Empty, "Table"))
            While Not (rs.EOF)
                Temp = rs("TABLE_NAME")
                Select Case True
                    Case Temp Like "Report$*"
                    Case Temp Like "Gooh$*"
                    Case Temp Like "*$_*"
                    Case Else
                        N = N + 1: ReDim Preserve a(1 To 2, 1 To N)
                        a(1, N) = fn
                        a(2, N) = Left$(Temp, Len(Temp) - IIf(Temp Like "*'", 2, 1))
                End Select
                rs.MoveNext
            Wend
            rs.Close
            .Close
        End With
        fn = Dir
    Loop
    Cells(1).Resize(N, 2).Value = Application.Transpose(a)
End Sub

 

[YasserKhalil]

That's wonderful Mr. Jindon
It works like charm and works exactly as I need
Thank you very very very much for genius solutions