List of worksheets in the folder

mardro · May 25th 2016

Hi All, I need to create a list of worksheet in the currrent folder and then I will use the list for Indirect formula. I have found the code to create the list, but the format of the list which the code generates is not what I need. I would like to have list of the all worksheets in the first column and path to the workseets in the second column so it can be used for Indirect formula. Please can you help me to modify the code as I do not fully understand it. Also if possible I would like to exclude some worksheets from the list eg. "sample1" and "sample2".

skywriter · May 25th 2016

Re: List of worksheets in the folder

Let's make sure we're on the same page, a workbook is the file that has worksheets inside of it, some mistakenly refer to a workbook as a worksheet.

In you example Book1.xlsm is a workbook and Sheet1 is a worksheet inside of it.

So when you say you want to exclude some worksheets from the list are you actually talking about worksheets or workbooks.

What is the real list of names, is it really "Sample1" and "Sample2", if not what are the names?

mardro · May 26th 2016

Re: List of worksheets in the folder

I really mean worksheets. In my case there will be a few workbooks in the folder, each contains a few worksheets. In each workbook some worksheets will be the same with standard data so I would like to exclude them, not sure about the name now, but this will be like "Data1" and "Data2". The names of the standard worksheets will not be changed often so when necessary I can modify the macro.

skywriter · May 26th 2016

Re: List of worksheets in the folder

Try this. :cool:

Code

Option Explicit
Dim nr As Long
Sub ertert()
Dim Fldr$, f$, j&, fileNames$(), nm$
Fldr = ThisWorkbook.Path: If Fldr = "" Then Exit Sub
Application.ScreenUpdating = False
ActiveSheet.UsedRange.Offset(1).ClearContents
If Right(Fldr, 1) <> "\" Then Fldr = Fldr & "\"
nm = ThisWorkbook.Name
On Error GoTo Metka
f = Dir(Fldr & "*.xls*", vbNormal)
nr = 2
Do While f <> ""
    If f <> nm Then
    GetSheetsNames Fldr & f
    End If
    f = Dir()
Loop
Application.ScreenUpdating = True
Metka:
End Sub


Function GetSheetsNames(file)
Dim wb As Workbook, ws As Worksheet
Set wb = Workbooks.Open(file)
For Each ws In wb.Worksheets
    If Not ws.Name Like "Data*" Then
        ThisWorkbook.ActiveSheet.Cells(nr, 1).Value = ws.Name
        ThisWorkbook.ActiveSheet.Cells(nr, 2).Value = file
        nr = nr + 1
    End If
Next ws
wb.Close False
End Function

Display More

mardro · May 26th 2016

Re: List of worksheets in the folder

Thanks a lot for your help skywriter. Generally your code works as I wanted, however I receive many warning messages when it try to open the workbooks. Please see the pictures below, not sure if this is because the worksheets contain access query or they are protected. I think the code I have posted work in different method and then there is not issue like this. Would it be possible to modify the initial code to get the same results?

[ATTACH=CONFIG]69240[/ATTACH][ATTACH=CONFIG]69241[/ATTACH]

skywriter · May 26th 2016

Re: List of worksheets in the folder

Showing a picture of an error message, but not telling me what line it occurred on isn't very helpful.

mardro · May 26th 2016

Re: List of worksheets in the folder

Sorry for not being helpful, but as you can see the "Debug" button is not active so I cannot check the error. Maybe the error came from the workbook that your code try to open, as I have mentioned before there is access query which wants to be updated. The code I have posted works fine in this case, but I need to modify the format it receive the list of the worksheet.

skywriter · May 26th 2016

Re: List of worksheets in the folder

That's not the picture I remember seeing last night.

The picture I see is a warning about macros.

Okay, well good luck.

mardro · May 26th 2016

Re: List of worksheets in the folder

I have uploaded two pictures in post #5 (untitled.jpg and untitled2.jpg). The first one is a warning about macro and if I click OK that I can see the second picture "Run time error". On the second warning the debug button is not active. Sorry but not sure what do you mean that is not the picture you saw last night.
Anyway I have tried to modify the macro by my own, but I have just basic knowledge about this and I cannot understand how this macro works. I think that is nothing wrong with your code, just when it open the workbooks it also starts the macros from Workbook_Open() section. However the macro I have posted check the worksheet names in other way (without opening the file) so that is way I do not see the warning messages.
If it possible to modify the initial macro I would be very grateful. Below is just the code from the file I have uploaded in the first post.

Code

Option Explicit 'http://www.ozgrid.com/forum/showthread.php?t=166870


Sub ertert()
Dim Fldr$, f$, j&, fileNames$(), nm$, sheetNames()
Fldr = ThisWorkbook.Path: If Fldr = "" Then Exit Sub    ':)
Application.ScreenUpdating = False
ActiveSheet.UsedRange.Offset(1).ClearContents
If Right(Fldr, 1) <> "\" Then Fldr = Fldr & "\"
nm = ThisWorkbook.Name
On Error GoTo Metka
f = Dir(Fldr & "*.xls*", vbNormal)
Do While f <> ""
    If f <> nm Then
        ReDim Preserve fileNames(j): fileNames(j) = f: j = j + 1
        sheetNames() = ListSpreadsheets(Fldr & f)
        Cells(j + 1, 2).Resize(, UBound(sheetNames)).Value = sheetNames()
    End If
    f = Dir()
Loop
Range("A2").Resize(UBound(fileNames) + 1).Value = WorksheetFunction.Transpose(fileNames)
Application.ScreenUpdating = True
Metka:
End Sub


'Based on:
'http://www.planetaexcel.ru/forum.php?thread_id=13569
'http://www.rondebruin.nl/ado.htm
'ZVI:2010-02-16 http://www.planetaexcel.ru/forum.php?thread_id=13569
'http://www.excelforum.com/excel-programming/798233-finding-sheet-names-in-a-closed-file.html
'http://www.vb-helper.com/howto_ado_list_tables_fields.html
'and http://support.microsoft.com/kb/257819
'********************************************************************
'***** Set Reference to Microsoft ActiveX Data Objects 2.8 Library
'********************************************************************
Function ListSpreadsheets(ByVal FileName As String)
Dim sPrv$, sConStr$, y(), i&
If Val(Application.Version) < 12 Then
    sPrv = "Microsoft.Jet.OLEDB.4.0": sConStr = "Data Source=" & FileName & ";Extended Properties=Excel 8.0;"
Else
    sPrv = "Microsoft.ACE.OLEDB.12.0": sConStr = "Data Source=" & FileName & ";Extended Properties=Excel 12.0;"
End If


With New ADODB.Connection
    .Provider = sPrv: .ConnectionString = sConStr: .CursorLocation = adUseClient: .Open
'    With .OpenSchema(adSchemaTables)
    With .OpenSchema(adSchemaTables, Array(Empty, Empty, Empty, "Table"))
        ReDim y(1 To CLng(.RecordCount))
        For i = 1 To UBound(y)
            y(i) = Replace(.Fields("TABLE_NAME").Value, "$", ""): .MoveNext
        Next i: .Close
    End With: .Close
End With
ListSpreadsheets = y()
End Function

Display More

apo · May 29th 2016

Re: List of worksheets in the folder

Try something like this as a minor alternative..

Code

Sub Test()
    Dim x, fldr As FileDialog, SelFold As String, i As Long, cnt As Long, ws As Worksheet
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.DisplayAlerts = False
    Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
    With fldr
        .Title = "Select a Folder"
        If .Show <> -1 Then Exit Sub
        SelFold = .SelectedItems(1)
    End With
    x = Split(CreateObject("wscript.shell").exec("cmd /c Dir """ & SelFold & "\*.xls"" /s/b").stdout.readall, vbCrLf)
    cnt = 1
    For i = LBound(x) To UBound(x) - 1
        With GetObject(x(i))
            For Each ws In .Sheets
             If Not ws.Name Like "Data*" Then
                Cells(i + cnt, 1).Value = ws.Name
                Cells(i + cnt, 2).Value = x(i)
                cnt = cnt + 1
             End If
            Next ws
            .Close False
            cnt = cnt - 1
        End With
    Next
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Sub

Display More

mardro · May 30th 2016

Re: List of worksheets in the folder

Thanks apo for your code. I had to change extension in the code as it did not pick up any file. When I change it to *.xlsx the code works fine, but if I change it to *.xlsm or *.xls* (as there are *.xlsm files in the folder as well) the macro closes the current workbook without any error. Any idea what is wrong?

apo · May 30th 2016

Re: List of worksheets in the folder

The code i posted should pick up xlsx files (does for me here)...

Quote

the macro closes the current workbook without any error

Don't have the xlsm Workbook that contains the above code in the same folder as the one your searching on..

**Trebor76** · May 31st 2016

Re: List of worksheets in the folder

Hi mardro,

When you say..

"Hi all, I need to create a list of worksheet in the current folder and then I will use the list for Indirect formula."

...do you realise that the INDIRECT formula does NOT work on closed workbooks? It would be a shame to do all this work only to discover you can't do what you originally wanted to do. If you do know this then all good.

Regards,

Robert

mardro · May 31st 2016

Re: List of worksheets in the folder

Quote

Don't have the xlsm Workbook that contains the above code in the same folder as the one your searching on..

If I take the workbook out of the folder which is searched the code works perfectly. Thanks a lot for it. Is it possible to modify the macro that the workbook can be in the searched folder? If not, do not worry, I can live with it

Quote

...do you realise that the INDIRECT formula does NOT work on closed workbooks? It would be a shame to do all this work only to discover you can't do what you originally wanted to do. If you do know this then all good.

Yes I am aware of this. I will need to open some workbooks to make it working

List of worksheets in the folder

Participate now!

Share