Count of Files in folders and subfolders

These two functions will do the counting:

' Lists the files of a folder and its subfolders
' including the subfolder name but without the
' root path (drive letter and parent folder).
'
' Returns the count of files.
'
' Will fail if permission to a subfolder is denied.
'
' Example:
'   FileCount = ListFolderFiles("C:\Windows")
'   will list:
'       bfsvc.exe
'       bootstat.dat
'       ...
'       addins\FXSEXT.ecf
'       appcompat\appraiser\APPRAISER_FileInventory.xml
'       ...
'
' 2017-10-22. Gustav Brock. Cactus Data ApS, CPH.
'
Public Function ListFolderFiles( _
    ByVal Path As String) _
    As Long
    
    Dim FileNames   As Variant
    Dim Item        As Long
    
    FileNames = FolderFileNames(Path)
    If Not IsEmpty(FileNames) Then
        For Item = LBound(FileNames) To UBound(FileNames)
            Debug.Print FileNames(Item)
        Next
    End If
    
    ListFolderFiles = Item

End Function


' Returns an array of file names of the specified Path
' and its subfolders including subfolder name but without
' the root path (drive letter and parent folder).
' Names of subfolders themselves are excluded.
'
' The array holds one file name, if Path is a file.
'
' Will fail if permission to a subfolder is denied.
'
' Example:
'   FileNameArray = FolderFileNames("C:\Windows\bootstat.dat")
'   will hold:
'       bootstat.dat
'
'   FileNameArray = FolderFileNames("C:\Windows")
'   will hold:
'       bfsvc.exe
'       bootstat.dat
'       ...
'       addins\FXSEXT.ecf
'       appcompat\appraiser\APPRAISER_FileInventory.xml
'       ...
'
' Format is similar to the DOS command with no root path:
'   Dir "C:\Windows" /A:-D /B /S
'   that will output:
'       C:\Windows\bfsvc.exe
'       C:\Windows\bootstat.dat
'       ...
'       C:\Windows\addins\FXSEXT.ecf
'       C:\Windows\appcompat\appraiser\APPRAISER_FileInventory.xml
'       ...
'
' Parameter ParentFolderName is for internal use only and
' must not be specified initially.
'
' 2017-10-22. Gustav Brock. Cactus Data ApS, CPH.
'
Public Function FolderFileNames( _
    ByVal Path As String, _
    Optional ByVal ParentFolderName As String) _
    As Variant

    Dim FileSystemObject    As Scripting.FileSystemObject
    Dim Folder              As Scripting.Folder
    Dim SubFolder           As Scripting.Folder
    Dim Files               As Scripting.Files
    Dim File                As Scripting.File
    Dim FileList            As Variant
    Dim FileListSub         As Variant

    Set FileSystemObject = New FileSystemObject
    
    If FileSystemObject.FolderExists(Path) Then
        Set Folder = FileSystemObject.GetFolder(Path)
        Set Files = Folder.Files
    
        For Each File In Files
            If IsEmpty(FileList) Then
                FileList = Array(FileSystemObject.BuildPath(ParentFolderName, File.Name))
            Else
                FileList = Split(Join(FileList, ":") & ":" & FileSystemObject.BuildPath(ParentFolderName, File.Name), ":")
            End If
        Next
        For Each SubFolder In Folder.SubFolders
            FileListSub = FolderFileNames(SubFolder.Path, FileSystemObject.BuildPath(ParentFolderName, FileSystemObject.GetBaseName(SubFolder)))
            If Not IsEmpty(FileListSub) Then
                If IsEmpty(FileList) Then
                    FileList = FileListSub
                Else
                    FileList = Split(Join(FileList, ":") & ":" & Join(FileListSub, ":"), ":")
                End If
            End If
        Next
    ElseIf FileSystemObject.FileExists(Path) Then
        FileList = Array(FileSystemObject.GetFile(Path).Name)
    Else
        ' Nothing to return.
        ' Return Empty.
    End If
    
    FolderFileNames = FileList
    
End Function

Select allOpen in new window

/gustav

Try ROBOCOPY instead of XCOPY for the Dir to Dir copying...

Robocopy

---

»bp

HI, I was unable to try it... needs to call for DIr, so that i can select the DIR

Hi Bill Prew,

For some unknown reason Robocopy did not work on my system.

Thanks!

It is not quite clear what you want. Dir doesn't select a "dir" (folder).

/gustav

For finding files, I have made this small .Net app a long time ago (FindFoldersWithManyFiles.exe):

https://drive.google.com/open?id=0B5vWLrzEkj6DNTFESDhoLU5jZEE


Originally made to find only big folders. But if you want to see all folder, fill in 0 in the appropiate field

Also note, big files usually take a long time! The program usually can't do it faster, even if you change from xcopy to robocopy or any other program.
Just monitor disk speed to compare the programs, you'll probably see they're maxed out at xx MB/s (which is probably the rated hard disk speed for that model).

Hi gustav,
I was looking for folder selection option. For instance when i run the macro it need to ask for the folder path.
Select the folder and run the macro.

Thanks!

Here is an example using: FileDialog

/gustav

Hi Kimputer,

The tool is similar what Iam looking for. But few requirement which will help me achieve the goal.
1. There is no export function
2. The full path is not required ( only folder name)
3.Total count of files
4.Split of file count according to extn

Thanks!

With that many extra requirements, it should really be a Gigs instead:
https://www.experts-exchange.com/gigs/

How deep do you want this subfolder traversal to go?

Can you provide a sample showing the files and folders and subfolders you use in a test, and then the output you would want, with example folders and counts and how it would be organized.

---

»bp

HI,
 Bill Prew / Kimputer

I do not know if Iam confusing the requirement . Please find the attached.



Thanks!
CPH
This-is-purely-an-excel-based-macro.docx

You have the bits and pieces here.

If you want a ready boiled solution, you should open a project in Gigs.

/gustav

Hi All,

In Simple lines Iam looking for the DOS cmd       "dir *.* /w /s "   which will display Total no of DIR and no of Files.

Please convert the DOS option to Macros where I can get the List of DIR along with count of Files in Excel.

Thanks!

Do you want this as the list of directory names?

dir /ad /s /b /-C

Select allOpen in new window

Do you need the total number of files or the total number of files in each directory?

HI Aikimark,
I need count of files in each sub Dir , including any empty dir which will display as "0"

Thanks!

Okay, here is a workbook with a VBA macro in it you can run called CountExt.  It will prompt for the base folder to start from, then add a new sheet to the end and populate it with the info I *think* you are looking for.  A sample sheet that I ran here is included, but when you test it you will get a new sheet added for your data.  See what you think...

EE29065834.xlsm

---

»bp

This function uses the dir and findstr commands to gather the data.  Then the data is transformed into an array containing the directory name, file count, and number of bytes.

Function Q_29065834(ByVal parmTopDir As String)
    Dim strData As String
    Dim oWSH As Object
    
    Dim oFS, oTS
    Const ForReading = 1, ForWriting = 2, ForAppending = 8
    Const TristateUseDefault = -2, TristateTrue = -1, TristateFalse = 0

    Static oRE As Object

    Set oWSH = CreateObject("wscript.shell")
    oWSH.Run "cmd /c cd " & parmTopDir & " & dir /w /s | findstr ""File(s) Directory"" > Q_29065834.txt", 0, True
    
    Set oFS = CreateObject("scripting.filesystemobject")
    Set oTS = oFS.OpenTextFile(parmTopDir & "\Q_29065834.txt", ForReading, True, TristateFalse)
    strData = oTS.readall
    oTS.Close
    
    strData = Replace(strData, " Directory of ", "")
    'remove file count summary lines
    strData = Left(strData, InStrRev(strData, "File(s)") - 1)
    strData = Left(strData, InStrRev(strData, vbCrLf) - 1)
    
    Set oRE = CreateObject("vbscript.regexp")
    oRE.Global = True
    oRE.Pattern = "\r\n +"

    If oRE.test(strData) Then
        strData = oRE.Replace(strData, vbTab)
    End If
    
    oRE.Pattern = "(File\(s\))( +)"
    strData = oRE.Replace(strData, "$1" & vbTab)
    
'    Set oTS = oFS.OpenTextFile(parmTopDir & "\Q_29065834.txt", ForWriting, True, TristateFalse)
'    oTS.write strData
'    oTS.Close
    
    Q_29065834 = Split(strData, vbCrLf)

End Function

Select allOpen in new window

Example invocation:

x = Q_29065834(environ("homepath") & "\downloads")

?ubound(x)
 4885 

?x(0)
C:\Users\Mark\Downloads 1628 File(s)  9,687,821,627 bytes

?x(4885)
C:\Users\Mark\Downloads\XmlPad302azip   1 File(s)     10,989,479 bytes

Select allOpen in new window

Note: I edited my posted code snippet to replace spaces after "File(s)" with a tab character.  This would make it easier to split the array item into its three constituent data.

The Findstr command doesn't do a proper job of filtering.  So, I do all the parsing in this version of the VBA code.  Regular expressions to the rescue.

Function Q_29065834(ByVal parmTopDir As String)
    Dim strData As String
    Dim oWSH As Object
    
    Dim oFS, oTS
    Const ForReading = 1, ForWriting = 2, ForAppending = 8
    Const TristateUseDefault = -2, TristateTrue = -1, TristateFalse = 0

    Dim oRE As Object
    Dim oMatches As Object
    Dim lngMatch As Long
    
    Dim vResult As Variant
    
    Set oWSH = CreateObject("wscript.shell")
    oWSH.Run "cmd /c cd " & parmTopDir & " & dir /-C /w /s > Q_29065834.txt", 0, True
    
    Set oFS = CreateObject("scripting.filesystemobject")
    Set oTS = oFS.OpenTextFile(parmTopDir & "\Q_29065834.txt", ForReading, True, TristateFalse)
    strData = oTS.readall
    oTS.Close
    
    Set oRE = CreateObject("vbscript.regexp")
    oRE.Global = True
    oRE.Pattern = "(?:\n|^) Directory of (\S[^\r]+\S)\r\n(?:.|\n)+?(?= +\d+ File\(s\)) +(\d+) File\(s\) +(\d[^ ]*) bytes"

    If oRE.test(strData) Then
        Set oMatches = oRE.Execute(strData)
        ReDim vResult(0 To oMatches.Count - 1)
        For lngMatch = 0 To oMatches.Count - 1
            With oMatches(lngMatch)
                vResult(lngMatch) = .submatches(0) & vbTab & .submatches(1) & vbTab & .submatches(2)
            End With
        Next
    End If
    
    Q_29065834 = vResult
End Function

Select allOpen in new window

I worked out the Findstr problem.  This version of the function returns a 2D array.  No need to use the Split() function on the results.

Function Q_29065834a(ByVal parmTopDir As String)
    Dim strData As String
    Dim oWSH As Object
    
    Dim oFS, oTS
    Const ForReading = 1, ForWriting = 2, ForAppending = 8
    Const TristateUseDefault = -2, TristateTrue = -1, TristateFalse = 0

    Dim oRE As Object
    Dim oMatches As Object
    Dim lngMatch As Long
    Dim lngSM As Long
    
    Dim vResult As Variant
    
    Set oWSH = CreateObject("wscript.shell")
    oWSH.Run "cmd /c cd " & parmTopDir & " & dir /-C /w /s | findstr /R ""^ Directory of | File\(s\) "" > Q_29065834.txt", 0, True
    
    Set oFS = CreateObject("scripting.filesystemobject")
    Set oTS = oFS.OpenTextFile(parmTopDir & "\Q_29065834.txt", ForReading, True, TristateFalse)
    strData = oTS.readall
    oTS.Close
    oFS.deletefile parmTopDir & "\Q_29065834.txt"
    
    Set oRE = CreateObject("vbscript.regexp")
    oRE.Global = True
    
    'remove totals at the end
    oRE.Pattern = "( +(\d+) File\(s\) +(\d[^ ]*) bytes)\r\n +(\d+) File\(s\) +(\d[^ ]*) bytes\s+$"
    If oRE.test(strData) Then
        strData = oRE.Replace(strData, "$1")
    End If
    
    oRE.Pattern = "(?:\n|^) Directory of (\S[^\r]+\S)\r\n(?:.|\n)+?(?= +\d+ File\(s\)) +(\d+) File\(s\) +(\d[^ ]*) bytes"
    If oRE.test(strData) Then
        Set oMatches = oRE.Execute(strData)
        strData = vbNullString
        ReDim vResult(0 To oMatches.Count - 1, 0 To oMatches(0).submatches.Count - 1)
        For lngMatch = 0 To oMatches.Count - 1
            With oMatches(lngMatch)
                For lngSM = 0 To .submatches.Count - 1
                    vResult(lngMatch, lngSM) = .submatches(lngSM)
                Next
            End With
        Next
    End If
    
    Q_29065834a = vResult
End Function

Select allOpen in new window

HI, Aikimark

It will be great if  you add a line of code for the user to pick the folder and process.

Hi,Bill Prew
The output was interesting , but  the actual DIR  output exceeded the excel row limit, hence could not proceed. This will be good if the output is continued in the next sheet of workbook..... Also remove the size as it is not required.

What i thought if the header is unique as per the extn i can save every alternate rows . (As per enclosure)

Thanks!
CPH
File-count.xlsx

@CPH

if  you add a line of code

What I've posted is a function where you pass the top level directory (string).  Prompting the user is what you do OUTSIDE of this function, using the Application.Dialogs().Show method.

but  the actual DIR  output exceeded the excel row limit

You are doing this for over a million files ???

---

»bp

I would ask: Are you doing this for over a million directories?!?

Thanks aikimark, agreed, worded wrong, I was caught up in the thought of running this against so many folders and files.

---

»bp

Yes.  Not sure what my function will do with data this size.  The Regex engine can fail (or fail to complete) for memory reasons.  I've been testing with a directory tree that is a little less than 5000 directories.  CPH is planning to throw 200 times that data at the function.

Hi Bill Prew / Aikimark ,

Good! It actually relaxed my nerves for a while....   based on Bill Prew's  solution , it creates output in 2 rows . I was trying  to make a point to have a unique header, so that output remains in single row.

Thanks!
CPH

Adjusting to single row format...

---

»bp

Thanks! Bill Prew,

It is the folders which got duplicated during various backups and systems .It is for a cleanup process.

Thanks!
CPH

Thanks!  to Bill Prew  with the final solution and Aikimark  for the contribution.

Thanks!
CPH

If you stored the results in an array, you could transfer the data in a single operation.  It's quite fast.
https://www.experts-exchange.com/articles/2253/Fast-Data-Push-to-Excel.html

per OP comment