Count Files In A Folder VBA

[Admin]

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.




'// 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