I pieced together this code in answer to the following OP post on Stack Overflow: Get worksheet Names of All .xlsx files in a folder
The OP basically wanted to loop all .xlsx files in a folder and produce a list of worksheets and workbooks contained therein; and they gave an example output format.
Could I please have feedback on the following code, with particular focus on the encapsulation? How should I correctly address encapsulation so as to still produce the same output but without exposing the public fields e.g.
My code design:
I sought to create a process that would:
1) Get the worksheet names without opening the files;
2) Use a global collection with custom class to store the Filename and worksheet names in key, value pairs where both the "key" and the "value" could be accessed;
3) Produce output in the format the OP specified.
Example output format given by OP:
Number of workbooks = 3
Number of Worksheets = 100
ReportNames = TestFile1, TestFile2, TestFile3
SheetNames = TestFile1:TestSheet1, TestFile1:TestSheet2, TestFile1:TestSheet3, TestFile1:TestSheet4
I didn't post my answer as I was unclear on how to alter my code properly to fix a number of my public fields breaking encapsulation i.e. I should have Get/Setters, I believe, but am not sure how to implement correctly. The overall code is a little patchwork-like and I give the links to any code sources where I have adapted code from elsewhere.
class module called
Option Explicit 'https://stackoverflow.com/questions/5702362/vba-collection-list-of-keys Public key As String Public value As String Public Sub Init(ByVal k As String, ByVal v As String) key = k value = v End Sub
In standard module 1:
Option Explicit Public numWorksheets As Long Public kv As KeyValue Public Col As Collection
In standard module 2:
Option Explicit Public Sub LoopAllExcelFilesInFolder() 'https://www.thespreadsheetguru.com/the-code-vault/2014/4/23/loop-through-all-excel-files-in-a-given-folder Dim wb As Workbook Dim myPath As String Dim filename As String Dim myExtension As String Dim FldrPicker As FileDialog Dim numWorkbooks As Long numWorkbooks = 0 numWorksheets = 0 Set Col = New Collection 'Optimize Macro Speed Application.ScreenUpdating = False Application.EnableEvents = False Application.Calculation = xlCalculationManual Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker) With FldrPicker .Title = "Select A Target Folder" .AllowMultiSelect = False If .Show <> -1 Then GoTo NextCode myPath = .SelectedItems(1) & "\" End With NextCode: 'In Case of Cancel myPath = myPath If myPath = vbNullString Then GoTo ResetSettings myExtension = "*.xlsx*" 'Target File Extension (must include wildcard "*") filename = Dir(myPath & myExtension) Do While filename <> vbNullString DoEvents numWorkbooks = numWorkbooks + 1 AddItemsToCollection myPath, filename filename = Dir Loop Dim ReportNames As String Dim SheetNames As String Dim counter As Long ReportNames = vbNullString SheetNames = vbNullString For Each kv In Col If InStr(1, ReportNames, kv.key) = 0 Then counter = counter + 1 ReportNames = ReportNames & kv.key & " " End If SheetNames = SheetNames & kv.key & ":" & kv.value & " " Next kv ReportNames = "ReportNames = " & Replace$(Trim$(ReportNames), " ", ",") SheetNames = "SheetNames = " & Replace$(Trim$(SheetNames), " ", ",") Debug.Print "Num of Workbooks = " & numWorkbooks, "Num of Worksheets = " & numWorksheets Debug.Print ReportNames Debug.Print SheetNames ResetSettings: 'Reset Macro Optimization Settings Application.EnableEvents = True Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True End Sub
In standard module 3:
Option Explicit ''====================================================== ' Required references: 'Microsoft ActiveX Data Object X.X Library 'Microsoft ADO Ext. X.X for DLL and Security ''===================================================== Public Sub AddItemsToCollection(ByVal path As String, ByVal filename As String) Dim objConn As ADODB.Connection Dim objCat As ADOX.Catalog Dim tbl As ADOX.Table Dim sConnString As String Dim WBName As String Dim wsName As String WBName = path & filename 'https://social.msdn.microsoft.com/Forums/windows/en-US/2cd64f27-135f-4d69-8f62-a3951c5e522b/how-to-checkinstall-jet-drivers?forum=winformsdatacontrols sConnString = "Provider=Microsoft.ACE.OLEDB.12.0;" & _ "Data Source=" & WBName & ";" & _ "Extended Properties=Excel 12.0;" Set objConn = New ADODB.Connection objConn.Open sConnString Set objCat = New ADOX.Catalog Set objCat.ActiveConnection = objConn For Each tbl In objCat.Tables numWorksheets = numWorksheets + 1 wsName = tbl.Name wsName = Application.Substitute(wsName, "'", vbNullString) wsName = Left$(wsName, InStr(1, wsName, "$", 1) - 1) Set kv = New KeyValue kv.Init filename, wsName Col.Add kv Set kv = Nothing Next tbl objConn.Close Set objCat = Nothing Set objConn = Nothing End Sub