Count all files with specific extension

Hello everyone
I have found the following UDF that is supposed to count all files with specific extension at this link
https://www.excelguru.ca/content.php?140

Code:

---

'Author          : Ken Puls (www.excelguru.ca)'Function purpose: To count files in a directory.  If a file extension is provided,
'  then count only files of that type, otherwise return a count of all files.
    Dim objFso As Object
    Dim objFiles As Object
    Dim objFile As Object

    'Set Error Handling
    On Error GoTo EarlyExit

    'Create objects to get a count of files in the directory
    Set objFso = CreateObject("Scripting.FileSystemObject")
    Set objFiles = objFso.GetFolder(strDirectory).Files

    'Count files (that match the extension if provided)
    If strExt = "*.*" Then
        CountFiles = objFiles.Count
    Else
        For Each objFile In objFiles
            If UCase(Right(objFile.Path, (Len(objFile.Path) - InStrRev(objFile.Path, ".")))) = UCase(strExt) Then
                CountFiles = CountFiles + 1
            End If
        Next objFile
    End If

EarlyExit:
    'Clean up
    On Error Resume Next
    Set objFile = Nothing
    Set objFiles = Nothing
    Set objFso = Nothing
    On Error GoTo 0 End Function

---

Code:

---

Sub Test()'Author      : Ken Puls (www.excelguru.ca)
'Macro Purpose: Test the CountFiles function
    Dim flDlg As FileDialog
    Dim dblCount As Double
    Set flDlg = Application.FileDialog(msoFileDialogFolderPicker)
    flDlg.Show
    dblCount = CountFiles(flDlg.SelectedItems(1))
    Debug.Print dblCount End Sub

---

It is working well for all the files but when try to use specific extension it returned 0

I tried such a line

Code:

---

dblCount = CountFiles(flDlg.SelectedItems(1), "*.xls*")

---

Any idea?

try removing the dot

eg:
dblCount = CountFiles(flDlg.SelectedItems(1), "*xls*")

Thanks a lot for reply but the same result 0 ...

Hello Yasser,

Here is simpler method...

Code:

---

Function GetFileCount(ByVal Folder As Variant, Optional ByVal FileFilter As String) As Variant


    Dim Files As Object
   
        If FileFilter = "" Then FileFilter = "*.*"
       
        With CreateObject("Shell.Application")
            Set Files = .Namespace(Folder).Items
            Files.Filter 64, FileFilter
            GetFileCount = Files.Count
        End With
       
End Function


Sub FileCountTest()


    Dim FileCount As Long
   
        With Application.FileDialog(msoFileDialogFolderPicker)
            If .Show = -1 Then
                Folder = .SelectedItems(1)
            Else
                Exit Sub
            End If
        End With
     
        FileCount = GetFileCount(Folder, "*.xls*")
       
End Sub

---

You're a legend Mr. Leith
I really like a lot your coding solutions and I am following you :)

Thank you very much

Hello Yasser,

You're welcome. Glad I could help and show you something new.

Code:

---

fld = "C:\VBAX\*.xl*"
lst = Filter(Split(CreateObject("wscript.shell").exec("cmd /c Dir " & fld & " /b /a-d").stdout.readall, vbCrLf), ".")
MsgBox UBound(lst) + 1

---

Thanks to SNB

Thanks a lot for all of you for great solutions
Best Regards

I have changed the path like that

Code:

---

fld = ThisWorkbook.Path & "\Test Folder\*.xl*"

---

And there are two excel files .. but I got 0
Any idea?

In Test Folder you have that 2 files? or in "ThisWorkbook.Path?

I put the code in my xlsm file and this file is next to "Test Folder" ...

Code:

---

fld = Chr(34) & ThisWorkbook.Path & "\Test Folder\*.xl*" & Chr(34)

---

Thank you very much Mr. MD
That works fine so the quotation marks would be put before and after the path .. But why? I usually use the technique without that quotation marks .. That's weird for me

The issue is the space in "Test Folder"

Thanks for clarification.
Best Regards

Hi Leith,

this is great code and works well for a single folder. However, I want it to loop through subfolders and give a count for a specific file extension in each folder.

This thread is 5 yo. please start a new thread and link to this one.