Count files in folder and subfolders, exlucing folders with string - vba

Question

Given a folder tree:
c:\example\
c:\example\2014-01-01\
c:\example\2014-01-01\Entered\
c:\example\2014-01-02\
c:\example\2014-01-02\Entered
etc.
I want to count the PDF files in the tree, but excluding any in the "Entered\" subfolders.
Is this possible even with VBA? Ultimately this count needs to be spit out onto an excel sheet.

Answer 1

copy all the code in an Excel-VBA Module. If you want to use a button then you should use CntFiles() on the button. But if you don't want to use a button then you can use fCount(strPath) as a formula on the Worksheet i.e =fCount("your-path"), the parameter is String so make it double-quoted when using on Worksheet.
Function fCount(strPath)
Dim fCnt As Integer
fCnt = ShowFolderList(strPath)
fCount = fCnt
End Function
Sub CntFiles()
Dim strPath As String
strPath = "A:\Asif\Answers\abc"
ShowFolderList (strPath)
End Sub
Function ShowFolderList(Path)
Dim fso, folder, subFlds, fld
Dim tFiles As Integer
tFiles = ShowFilesList(Path)
Set fso = CreateObject("Scripting.FileSystemObject")
Set folder = fso.GetFolder(Path)
Set subFlds = folder.SubFolders
For Each fld In subFlds
If fld.Name = "Entered" Then
GoTo SkipFld:
Else
Path = fld.Path
tFiles = tFiles + ShowFilesList(Path)
End If
SkipFld:
Next
'MsgBox tFiles & " files"
ShowFolderList = tFiles
End Function
Function ShowFilesList(folderspec)
Dim fso, f, f1, fc, s
Dim Cnt As Integer
Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.GetFolder(folderspec)
Set fc = f.Files
For Each f1 In fc
If GetAnExtension(f1) = "pdf" Then
Cnt = Cnt + 1
Else
End If
Next
ShowFilesList = Cnt
End Function
Function GetAnExtension(DriveSpec)
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
GetAnExtension = fso.GetExtensionName(DriveSpec)
End Function
This code will count all the files in the specified folder as well as sub-folders excluding folder named "Entered" as you specified.

Answer 2

This code gives you a nice overview in an excel sheet:
Sub start()
Application.ScreenUpdating = False
Dim FolderName As String
Sheets("fldr").Select
Cells(1, 1).Value = 2
With Application.FileDialog(msoFileDialogFolderPicker)
.AllowMultiSelect = False
.Show
On Error Resume Next
FolderName = .SelectedItems(1)
Err.Clear
On Error GoTo 0
End With
ListFolders (FolderName)
Application.ScreenUpdating = True
MsgBox "Done" & vbCrLf & "Total files found: " & Cells(1, 1).Value
Cells(1, 1).Value = "Source"
Cells(1, 2).Value = "Folder"
Cells(1, 3).Value = "Subfolder"
Cells(1, 4).Value = "FileCount"
End Sub
Sub ListFolders(Fldr As String)
Dim fs
Set fs = CreateObject("Scripting.FileSystemObject")
Dim fl1
Set fl1 = CreateObject("Scripting.FileSystemObject")
Dim fl2
Set fl2 = CreateObject("Scripting.FileSystemObject")
Set fl1 = fs.GetFolder(Fldr)
For Each fl2 In fl1.SubFolders
Cells(Cells(1, 1).Value, 1).Value = Replace(Fldr, fl1.Name, "")
Cells(Cells(1, 1).Value, 2).Value = fl1.Name
Cells(Cells(1, 1).Value, 3).Value = fl2.Name
Cells(Cells(1, 1).Value, 4).Value = CountFiles(Fldr & "\" & fl2.Name)
Cells(1, 1).Value = Cells(1, 1).Value + 1
ListFolders fl2.Path
Next
End Sub
Function CountFiles(Fldr As String)
Dim fso As Object
Dim objFiles As Object
Dim obj As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Set objFiles = fso.GetFolder(Fldr).Files
CountFiles = objFiles.Count
Set objFiles = Nothing
Set fso = Nothing
Set obj = Nothing
End Function