Get the Worksheet Name of all the .xlsx Workbooks inside a directory - vba

Question

I have a textbox where I am getting an Input Directory and calculating the number of .xlsx reports and the total number of worksheets in those report.
I would like to get the report name and sheetname of each of those report.
What could be the quickest way to get that.
As there are cases where it could be 100 workbooks and total of 1000 worksheets inside them.
Here goes my code which Just gets the number of reports and worksheets in those reports.
Private Sub FL_TextBox_Change()
Dim FolderPath As String
Dim path As String
Dim count As Integer
Dim Wk As Workbook
Dim Ws As Workbook
Set Ws = ActiveWorkbook
FolderPath = NewTask.FL_TextBox.Value
MsgBox ("Click Ok & Wait for the Total Number of Reports and Worksheets" & vbNewLine & vbNewLine & "to be calculated.")
If FolderPath = "" Then
NewTask.Num_Rpt_TextBox.Value = ""
Ws.Sheets("Config").Range("I1").Value = ""
Else
path = FolderPath & "\*.xlsx"
Filename = Dir(path)
File = (FolderPath & "\" & Filename)
wkcount = 0
Shcount = 0
shtcount = 0
RptSheets = ""
Do While Filename <> ""
wkcount = wkcount + 1
File = FolderPath & "\" & Filename
Set Wk = Workbooks.Open(File, ReadOnly:=True)
Shcount = Wk.Sheets.count
If RptSheets <> "" Then
RptSheets = RptSheets & "," & Shcount
Else
RptSheets = Shcount
End If
Wk.Close
shtcount = shtcount + Shcount
Filename = Dir()
Loop
Ws.Sheets("Config").Range("I1").Value = RptSheets
XlsxFilesPresent = wkcount & " / " & shtcount
NewTask.Num_Rpt_TextBox.Value = XlsxFilesPresent
End If
End Sub
So, in short - I want to get the number of .xlsx reports and those report names and number of worksheets inside those report and the worksheet names in a structured way.
Something like
Number of workbooks = 3
Number of Worksheets = 100
ReportNames = TestFile1, TestFile2, TestFile3.
SheetNames = TestFile1:TestSheet1, TestFile1:TestSheet2, TestFile1:TestSheet3, TestFile1:TestSheet4 etc.,
Kindly share your thoughts in getting this process running faster.

Answer 1

It seems you have everything you need, you just need to add some lines to make an object that contains all of the data you need and then you can use that object to extract anything you want and I cannot think of anything better than a dictionary object.
All of the information of the sheets are stored in a collection object called worksheets so you can simply store that object and iterate through it to access worksheet names and possibly any other information you want. So first create a collection object and a dictionary object like this:
Dim coll As Object
Dim dict As Object
Set dict = CreateObject("scripting.dictionary")
Inside your do while loop use workbook names as keys and the worksheets object of that workbook as the item. Note that the keys should be unique and I assume that you will run this in one directory so file names must be unique forced by your OS.
To add keys and items inside the loop after you opened the workbook use this:
set coll=wk.Worksheets
dict.add Wk,coll
once the execution gets out of the loop you have a dictionary of all workbooks and their worksheets object. Now you can loop through the dictionary and form the data however you want. for example, let's say you want to print the workbook name and then the worksheets:
dim i as integer
dim key as variant
Dim sht As Worksheet
for each key in dict.keys
set coll=dict(key) 'sets the item of the dict=worksheets
For i = 1 To coll.Count 'loop through worksheets object and print their names
Set sht = coll(i)
Debug.Print key & ":" & sht.Name
Next
next key