Count Files In A Folder VBA

Hi All,

Here is a UDF, which counts number of files in a directory. There are 4 parameters, out of which 2 are optional.

Parameters:

1. FolderPath
2. Extn - Extension of file (you could use wild card as well. e.g. ".xls*")
3. [IncludeSubFolder] - By default it's false
4. [Criteria] - If you provide a criteria, count will be based based on that criteria of the filename


Call the function like

=COUNTFILESIF("C:\Users\",".*",TRUE,"exam")

I hope this might be a useful one.

Code:

---

'// ExcelFox.com - created on 07-May-2011
Dim COUNTFILES  As Long

Public Function COUNTFILESIF(ByVal FolderPath As String, ByVal Extn As String, _
                                Optional IncludeSubFolder As Boolean, _
                                Optional ByVal Criteria As String) As Long
   
    Dim FileName    As String
    Dim strExtn    As String
    Dim blnSkipCrit As Boolean
   
    If Right$(FolderPath, 1) <> "\" Then FolderPath = FolderPath & "\"
    If Not CBool(Len(Dir(FolderPath, vbNormal))) Then
        COUNTFILESIF = CVErr(2042)
        Exit Function
    End If
    COUNTFILES = 0
    Extn = LCase$(Replace(Extn, ".", ""))
    FileName = LCase$(Dir(FolderPath & "*." & Extn))
    If Len(Criteria) Then
        Criteria = LCase$(Criteria)
    Else
        blnSkipCrit = True
    End If
    Do While Len(FileName)
        strExtn = LCase$(Mid$(FileName, InStrRev(FileName, ".") + 1))
        If strExtn Like Extn Then
            If Not blnSkipCrit Then
                If InStr(1, FileName, Criteria) Then
                    COUNTFILESIF = COUNTFILESIF + 1
                End If
            Else
                COUNTFILESIF = COUNTFILESIF + 1
            End If
        End If
        FileName = LCase$(Dir())
    Loop
   
    If IncludeSubFolder Then
        SubFoldersFilesCount FolderPath, Extn, Criteria
        COUNTFILESIF = COUNTFILESIF + COUNTFILES
    End If
   
End Function
Private Sub SubFoldersFilesCount(ByVal Folder, ByVal Extn As String, _
                                    Optional ByVal Criteria As String)
    Dim objFSO      As Object
    Dim objFolder  As Object
    Dim strExtn    As String
    Dim blnSkipCrit As Boolean
   
    If objFSO Is Nothing Then
        Set objFSO = CreateObject("Scripting.FileSystemObject")
    End If
    Set Folder = objFSO.GetFolder(Folder)

    For Each SubFolder In Folder.SubFolders
        Set objFolder = objFSO.GetFolder(SubFolder.Path)
        For Each FileName In objFolder.Files
            strExtn = LCase$(Mid$(FileName, InStrRev(FileName, ".") + 1))
            If strExtn Like Extn Then
                If Not blnSkipCrit Then
                    If InStr(1, LCase$(FileName.Name), Criteria) Then
                        COUNTFILES = COUNTFILES + 1
                    End If
                Else
                    COUNTFILES = COUNTFILES + 1
                End If
            End If
        Next
        SubFoldersFilesCount SubFolder, Extn, Criteria
    Next
   
End Sub

---