VBA macro to find Sheet count in a directory

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

Possible duplicate of [Loop through files in a folder using VBA?](https://stackoverflow.com/questions/10380312/loop-through-files-in-a-folder-using-vba) — Ken White, May 03 '18 at 17:15
that doesnt add a page then run the Sheets function and copy it. the only similiarity is the looping through files and im okay on that portion — NormX, May 03 '18 at 17:31
You add a worksheet by using `WorkSheets.Add`, and you add the count by opening the file and reading `WorkSheets.Count()`. You're also not *okay on that portion*, because you're needlessly using `Scripting.FileSystemObject` in VBA where it's absolutely not needed, as VBA has native functionality to retrieve a list of files in a folder and open the workbooks. — Ken White, May 03 '18 at 19:00

score 1 · Answer 1 · answered May 03 '18 at 17:12

1

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

answered May 03 '18 at 17:12

JNevill

46,980
4
38
63

`writeCell.Value = objFile.Name` says there is a a error with that now – NormX May 03 '18 at 17:22
Be sure to check if the file is "*.xls" before you try to open it – HackSlash May 03 '18 at 17:46
Perhaps `Set WriteCell = ws.Cells....` Make sure to declare writeCell at the top of the code `Dim WriteCell as Range` and `Dim wb as Workbook`. That should help identify errors. – JNevill May 03 '18 at 18:20

score 1 · Accepted Answer · answered May 04 '18 at 15:02

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

score 0 · Answer 3 · answered May 03 '18 at 17:55

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

VBA macro to find Sheet count in a directory

3 Answers3