VBA macro to find Sheet count in a directory - vba

Question

I'm not good with VBA at all but I was curious to know if there is a way to count the amount of worksheets in a workbook that's looped for all the files in a folder.
For example, A1 list the file names and B1 shows the count of sheets.
A1 B1
book1 5
book2 6
currently have this code set up and need to adjust it
Sub ListAllFile()
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim ws As Worksheet
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set ws = Worksheets.Add
Set objFolder = objFSO.GetFolder("W:\101g-19 (4.20.18) - Copy\")
ws.Cells(1, 1).Value = "The files found in " & objFolder.Name & " are:"
For Each objFile In objFolder.Files
ws.Cells(ws.UsedRange.Rows.Count + 1, 1).Value = objFile.Name
'ADD A WORKSHEET AND PASTE "=SHEETS()" in A1 the copy value of a1 in to list
'close files with out saving
Next
Set objFolder = Nothing
Set objFile = Nothing
Set objFSO = Nothing
End Sub

Answer 1

Take a look at the below - note that you should run this from inside of a blank worksheet
Set CurrentWB = ActiveWorkbook
Dim folderPath As String
Dim Filename As String
Dim wb As Workbook
Dim J As Long
Dim N As Long
Dim lc As Long
Dim lr As Long
'UPDATE FOLDER PATH OF WHERE XLS FILES ARE LOCATED
folderPath = "C:\Users\username\Desktop\test\" 'change to suit
J = 2
' Column Headers
CurrentWB.Sheets(1).Range("A1").Value = "Filename"
CurrentWB.Sheets(1).Range("B1").Value = "# of Sheets"
If Right(folderPath, 1) <> "\" Then folderPath = folderPath + "\"
'YOU CAN CHANGE TO BE ANY FILE TYPE BUT CURRENTLY SET TO .XLSX
Filename = Dir(folderPath & "*.xlsx")
Do While Filename <> ""
Application.ScreenUpdating = False
Set TempWB = Workbooks.Open(folderPath & Filename)
' Counts Per Worksheet
N = ActiveWorkbook.Worksheets.Count
CurrentWB.Sheets(1).Range("A" & J).Formula = Filename
CurrentWB.Sheets(1).Range("B" & J).Formula = N
' Close Temporary Workbook
TempWB.Close False
J = J + 1
Filename = Dir
Loop

Answer 2

In your for loop, open the file (assuming they are all excel here) and get the count of worksheets.
Something like:
For Each objFile In objFolder.Files
writeCell = ws.Cells(ws.UsedRange.Rows.Count + 1, 1)
writeCell.Value = objFile.Name
'ADD A WORKSHEET AND PASTE "=SHEETS()" in A1 the copy value of a1 in to list
'close files with out saving
Set wb = Workbooks.Open(objFile.Name)
writeCell.Offset(,1).value = wb.Worksheets.Count()
wb.Close(false)
Next

Answer 3

Sub ListallFiles()
Dim sFileName As String
Dim sFolderPath As String: sFolderPath = "C:\Temp\" ' Change folder path. Ensure that folder path ends with "\"
Dim oWB As Workbook
Dim oWS As Worksheet
' Get the first excel file name from specified folder
sFileName = Dir(sFolderPath & "*.xls*")
' Add a worksheet
Set oWS = ThisWorkbook.Worksheets.Add
With oWS
' Set folder name in the new sheet
.Range("A1").Value = "The file found in " & sFolderPath & " are:"
' Loop through all excel files in the specified folder
Do While Len(Trim(sFileName)) > 0
' Open workbook
Set oWB = Workbooks.Open(sFolderPath & sFileName)
' Set workbook details in the file
.Range("A" & .Cells(.Rows.Count, "A").End(xlUp).Row + 1).Value = sFileName
.Range("B" & .Cells(.Rows.Count, "B").End(xlUp).Row + 1).Value = oWB.Worksheets.Count
' Close workbook
oWB.Close False
' Clear workbook object
Set oWB = Nothing
' Get next excel file
sFileName = Dir()
Loop
End With
End Sub
Above UDF should open all files in the specified folder and give you the number of worksheets in each workbook on a new worksheet