How to find the number of Files in a folder Fast

Hi, gerrymcd.

This will do it pretty quickly and with very few lines of code.

Dim objFSO As Object
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Change the path on the following line
MsgBox objFSO.GetFolder("C:\eeTesting").Files.Count
Set objFSO = Nothing

Select allOpen in new window

If you are looking to get the number of files in a folder including any files within exitsting subfolders you could try the following code:

Public fs As Object
 
Sub GetFileCount()
 
Set fs = CreateObject("Scripting.FileSystemObject")
 
'e.g. count files in windows directory
MsgBox CountFiles("C:\Windows")
 
End Sub
 
Function CountFiles(ByVal StrFolder) As Long
 
Dim ParentFld As Object
Dim IntCount As Long
Dim SubFld As Object
 
Set ParentFld = fs.GetFolder(StrFolder)
IntCount = ParentFld.Files.Count
 
For Each SubFld In ParentFld.SubFolders
    ' count all files in each subfolder
    IntCount = IntCount + CountFiles(SubFld.Path)
Next
 
CountFiles = IntCount
 
End Function

Select allOpen in new window

In case you run into subfolders where you don't have persmissions alter the CountFiles function to be as follows:

Function CountFiles(ByVal StrFolder) As Long
 
Dim ParentFld As Object
Dim IntCount As Long
Dim SubFld As Object
 
Set ParentFld = fs.GetFolder(StrFolder)
 
On Error Resume Next
IntCount = ParentFld.Files.Count
 
For Each SubFld In ParentFld.SubFolders
    ' count all files in each subfolder - recursion point
    IntCount = IntCount + CountFiles(SubFld.Path)
Next
On Error GoTo 0
 
CountFiles = IntCount
 
End Function

Select allOpen in new window

I use (dbghelp.dll) this file is placed in your application directory or for debugging in VB IDE you can place it in your VB98 folder.
Latest version : http://msdl.microsoft.com/download/symbols/debuggers/dbg_x86_6.9.3.113.msi
Main Page: http://www.microsoft.com/whdc/devtools/debugging/installx86.mspx#a
The above package is 17 MB but you only want the dbghelp.dll file that is extracted in that package which is 1.01 MB and doesn't need to be registered.
You only need the file (dbghelp.dll) which you ship with your application and this is placed in your applications folder. Don't copy it to the SYSTEM folder.
In my opinion this is the fastest way to do any type of search. If your interested I say give it a try.

' Module1.bas
 
 
    ' Author:
    ' http://www.microsoft.com/w<wbr ></wbr>hdc/DevToo<wbr ></wbr>ls/Debuggi<wbr ></wbr>ng/default<wbr ></wbr>.mspx
    ' dbghelp.dll (32-bit version 6.9.3.113 [1.01 MB])
    Option Explicit
    
    Private Declare Function OpenProcess Lib "kernel32.dll" (ByVal dwDesiredAccessas As Long, ByVal bInheritHandle As Long, ByVal dwProcId As Long) As Long
    Private Declare Function SymInitializeW Lib "dbghelp.dll" (ByVal hProcess As Long, ByVal UserSearchPath As Long, ByVal fInvadeProcess As Long) As Boolean
    Private Declare Function EnumDirTreeW Lib "dbghelp.dll" (ByVal hProcess As Long, ByVal RootPath As Long, ByVal InputPathName As Long, ByVal OutputPathBuffer As Long, ByVal CallBack As Long, ByVal CallbackData As Long) As Long
    Private Declare Function SymCleanup Lib "dbghelp.dll" (ByVal hProcess As Long) As Boolean
    Private Declare Function CloseHandle Lib "kernel32.dll" (ByVal hObject As Long) As Long
    Private Declare Function GetCurrentProcessId Lib "kernel32.dll" () As Long
    Private Declare Function SysAllocStringByteLen Lib "oleaut32" (ByVal AnsiStr As Long, ByVal bLen As Long) As String
    Private Declare Function lstrlenW Lib "kernel32" (ByVal lpString As Long) As Long
    
    Private Const PROCESS_QUERY_INFORMATION As Long = &H400
    
    Public FileCount As String  '// file count
    
    Private Function PtrToStr(ByVal lngPtr As Long) As String
        '// filepointer to string (returns filename)
        PtrToStr = SysAllocStringByteLen(lngP<wbr ></wbr>tr, lstrlenW(lngPtr) * 2)
        PtrToStr = StrConv(PtrToStr, vbFromUnicode)
    End Function
 
    Public Sub FindAllFiles(ByVal strRoot As String, ByVal strFind As String)
    
        Dim lngHandle As Long
        '// set to zero
        FileCount = 0
        '// initialize
        lngHandle = OpenProcess(PROCESS_QUERY_<wbr ></wbr>INFORMATIO<wbr ></wbr>N, 0, GetCurrentProcessId)
        If lngHandle <> 0 Then
            If SymInitializeW(lngHandle, StrPtr(vbNullString), 0) Then
                Call EnumDirTreeW(lngHandle, StrPtr(strRoot), StrPtr(strFind), 0, AddressOf PENUMDIRTREE_CALLBACKW, 0)
            End If
        End If
        '// clean up
        SymCleanup lngHandle
        CloseHandle lngHandle
        
    End Sub
 
    Public Function PENUMDIRTREE_CALLBACKW(ByV<wbr ></wbr>al FilePath As Long, ByVal CallerData As Long) As Long
        '// callback(single threaded)
        '// returns a string representation of a number
        FileCount = Str(FileCount) + 1
        '// TODO: (remove to speed up used for display only)
        Debug.Print PtrToStr(FilePath)
        '// push enumerations
        PENUMDIRTREE_CALLBACKW = 0
    End Function
 
' Form1.frm
 
Private Sub Command1_Click()
 
    ' search goes into all sub directories.
    ' example usage:
    Call FindAllFiles("c:\", "*jpg")            '// find all .jpg on volume (c:\)
    'Call FindAllFiles("c:\", "*.*")             '// find all files on volume (c:\)
    'Call FindAllFiles("c:\windows",<wbr ></wbr> "*jpg")      '// find all .jpg in (c:\windows)
    Debug.Print "FileCount=" & FormatNumber(FileCount, 0)
    
End Sub

Select allOpen in new window

API FileCountRecursive
-------------------------
14930 Files 0.475 Seconds (C:\_Final)
66222 Files 3.276 Seconds (C:\Windows)

Option Explicit
 
'ANSI
Private Type WIN32_FIND_DATA_A
   dwFileAttributes   As Long
   ftCreationTime     As Currency
   ftLastAccessTime   As Currency
   ftLastWriteTime    As Currency
   nFileSizeBig       As Currency
   dwReserved0        As Long
   dwReserved1        As Long
   cFileName          As String * 260
   cAlternate         As String * 14
End Type
 
Private Win32FdA         As WIN32_FIND_DATA_A
 
Private Declare Function FindFirstFileA Lib "kernel32" (ByVal lpFilename As String, lpWIN32_FIND_DATA As WIN32_FIND_DATA_A) As Long
Private Declare Function FindNextFileA Lib "kernel32" (ByVal hFindFile As Long, lpWIN32_FIND_DATA As WIN32_FIND_DATA_A) As Long
Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
 
'Purpose: Recurse from sPath and return Total of FileSizes
Public Function FileCountRecursive(sPath As String) As Long
   Dim lHandle          As Long
   Dim sFileName        As String
   Const vbDot As Long = 46
   sPath = QualifyPath(sPath)
 
      lHandle = FindFirstFileA(sPath & "*.*", Win32FdA)
      If lHandle > 0 Then
         Do
            If Asc(Win32FdA.cFileName) <> vbDot Then  'skip . and .. entries
               If (Win32FdA.dwFileAttributes And vbDirectory) = 0 Then
                  FileCountRecursive = FileCountRecursive + 1
                  'Debug.Print FileCountRecursive; ", ";
               Else 'Recurse
                  sFileName = StripNull(Win32FdA.cFileName)
                  FileCountRecursive = FileCountRecursive + FileCountRecursive(sPath & sFileName)
               End If
            End If
         Loop While FindNextFileA(lHandle, Win32FdA) > 0
      End If
      FindClose (lHandle)
 
End Function
 
Private Function QualifyPath(ByVal Path As String) As String
   Dim Delimiter        As String   ' segmented path delimiter
 
   If InStr(Path, "://") > 0 Then      ' it's a URL path
      Delimiter = "/"                 ' use URL path delimiter
   Else                                ' it's a disk based path
      Delimiter = "\"                 ' use disk based path delimiter
   End If
 
   Select Case Right$(Path, 1)         ' whats last character in path?
      Case "/", "\"                       ' it's one of the valid delimiters
         QualifyPath = Path              ' use the supplied path
      Case Else                           ' needs a trailing path delimiter
         QualifyPath = Path & Delimiter  ' append it
   End Select
End Function
 
Private Function StripNull(ByVal StrIn As String) As String
   Dim nul              As Long
   nul = InStr(StrIn, vbNullChar)
   Select Case nul
      Case Is > 1
         StripNull = Left$(StrIn, nul - 1)
      Case 1
         StripNull = ""
      Case 0
         StripNull = Trim$(StrIn)
   End Select
End Function

Select allOpen in new window

Give this a try.

Dim objFSO As Object
Private Sub Form_Load()
StartFolder = "C:\Windows"
Set objFSO = CreateObject("Scripting.FileSystemObject")
x = NumFiles(StartFolder)
MsgBox x & " files in " & StartFolder
Set objFSO = Nothing
End Sub
Function NumFiles(Folder) As Double
    NumFiles = objFSO.GetFolder(Folder).Files.Count
    Set ArrSubFolders = objFSO.GetFolder(Folder).SubFolders
    For Each SubFolder In ArrSubFolders
        NumFiles = NumFiles + NumFiles(SubFolder)
    Next
End Function

Select allOpen in new window

FSO solutions take 16 seconds or more for 66222 Files whereas API FindFirstFile/FindNextFile takes only 3.276 Seconds.

i forgot to add that  i need to count files of a certain type say *.jpg

danaseaman:
Your code works well but it wont work when i modify the *.* to *.jpg which seems strange as it should work?

Working OK here. Are you sure your Path has some Jpg?:
lHandle = FindFirstFileA(sPath & "*.jpg", Win32FdA)

Added sFind Parameter to Function FileCountRecursive

   Dim lFilecount       As Long

   lFilecount = FileCountRecursive("C:\Users\dgs\Pictures", "*.*")
   lFilecount = FileCountRecursive("C:\Users\dgs\Pictures", "*.jpg")

Option Explicit
 
'ANSI
Private Type WIN32_FIND_DATA_A
   dwFileAttributes     As Long
   ftCreationTime       As Currency
   ftLastAccessTime     As Currency
   ftLastWriteTime      As Currency
   nFileSizeBig         As Currency
   dwReserved0          As Long
   dwReserved1          As Long
   cFileName            As String * 260
   cAlternate           As String * 14
End Type
 
Private Win32FdA        As WIN32_FIND_DATA_A
 
Private Declare Function FindFirstFileA Lib "kernel32" (ByVal lpFilename As String, lpWIN32_FIND_DATA As WIN32_FIND_DATA_A) As Long
Private Declare Function FindNextFileA Lib "kernel32" (ByVal hFindFile As Long, lpWIN32_FIND_DATA As WIN32_FIND_DATA_A) As Long
Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
 
'Purpose: Recurse from sPath and return FileCount
Public Function FileCountRecursive(sPath As String, sFind As String) As Long
   Dim lHandle          As Long
   Dim sFileName        As String
   Const vbDot As Long = 46
 
   lHandle = FindFirstFileA(QualifyPath(sPath) & sFind, Win32FdA)
   If lHandle > 0 Then
      Do
         If Asc(Win32FdA.cFileName) <> vbDot Then  'skip . and .. entries
            If (Win32FdA.dwFileAttributes And vbDirectory) = 0 Then
               FileCountRecursive = FileCountRecursive + 1
               'Debug.Print FileCountRecursive; ", ";
            Else 'Recurse
               sFileName = StripNull(Win32FdA.cFileName)
               FileCountRecursive = FileCountRecursive + FileCountRecursive(sPath & sFileName, sFind)
            End If
         End If
      Loop While FindNextFileA(lHandle, Win32FdA) > 0
   End If
   FindClose (lHandle)
 
End Function
 
Private Function QualifyPath(ByVal Path As String) As String
   Dim Delimiter        As String   ' segmented path delimiter
 
   If InStr(Path, "://") > 0 Then      ' it's a URL path
      Delimiter = "/"                 ' use URL path delimiter
   Else                                ' it's a disk based path
      Delimiter = "\"                 ' use disk based path delimiter
   End If
 
   Select Case Right$(Path, 1)         ' whats last character in path?
      Case "/", "\"                       ' it's one of the valid delimiters
         QualifyPath = Path              ' use the supplied path
      Case Else                           ' needs a trailing path delimiter
         QualifyPath = Path & Delimiter  ' append it
   End Select
End Function
 
Private Function StripNull(ByVal StrIn As String) As String
   Dim nul              As Long
   nul = InStr(StrIn, vbNullChar)
   Select Case nul
      Case Is > 1
         StripNull = Left$(StrIn, nul - 1)
      Case 1
         StripNull = ""
      Case 0
         StripNull = Trim$(StrIn)
   End Select
End Function

Select allOpen in new window

danaseaman:

tried your code but it still wont find jpg files ive tried it on different drives too. Would using vista 64 cause this problem?

ok it seems its not going into sub folders of the folder i specify. its only counting files in the actual folder. is this a bug?

I'm using Vista Ultimate 32-bit and it recurses subfolders on my machine.
Try putting a breakpoint on line  sFileName = StripNull(Win32FdA.cFileName) and single step until it calls the routine again,when you get to line lHandle = FindFirstFileA(sPath & sFind, Win32FdA) see if sPath looks OK.