PDA

View Full Version : Count Files in Several Folders



Al Benitez
10-02-2009, 02:24 PM
I am an Excel mid level user I know nothing avout VBA.
I need to count the number of PDF files in several folders saved in a company server. I found a great function created by Ken Puls (attached)however the code only allows for counting the files in one folder... I need to count the files in 16 folders on a monthly interval.

Oorang
10-02-2009, 09:56 PM
This is one way:
Public Sub Example()
Dim fs As Office.FileSearch
Dim strPath As String
strPath = Environ$("USERPROFILE")
Set fs = Excel.Application.FileSearch
With fs
.NewSearch
.Filename = "*.pdf"
.LookIn = strPath
.SearchSubFolders = True
.Execute msoSortByFileName, msoSortOrderAscending
MsgBox "Found " & .FoundFiles.Count & " files."
End With
End Sub

parttime_guy
10-02-2009, 10:58 PM
Hi Al,

I tried using an old code on vbaexpress.com and amended it to meet ur requirements, just check this out.

Best regards

macropod
10-02-2009, 11:21 PM
Hi Al,

The code in the workbook attached to your post relies on Application.FileSearch (as do the solutions by Oorand and parttime_guy), which isn't supported on Vista (and, presumably, Win 7), so its future applicability is somewhat limited. The Dir function is still supported, though, and that will probably be the way to go.

That aside, are all the folders you need to search located under a common folder? If not, you'll need to supply your (new) code with a list of folders to be searched. Here's some code that shows how you might implement either approach:

Option Explicit
Dim ArrFolders() As Variant, StrType As String

Sub Get_File_Counts1(StrType As String)
Dim StrPath As String, VarChild As Variant, i As Integer
StrPath = "C:\Users\Al Benitez\Documents\"
VarChild = Dir(StrPath, vbDirectory)
Do While VarChild <> ""
If VarChild <> "." And VarChild <> ".." Then
If (GetAttr(StrPath & VarChild) And vbDirectory) = vbDirectory Then
i = i + 1
ReDim Preserve ArrFolders(2, i)
ArrFolders(1, i) = StrPath & VarChild
End If
End If
VarChild = Dir
Loop
For i = 1 To UBound(ArrFolders, 2)
ArrFolders(2, i) = CountFiles(ArrFolders(1, i), StrType)
Next
End Sub


Sub Get_File_Counts2(StrType As String)
Dim StrFolder As String, StrFolders As String, i As Integer
StrFolders = "C:\Users\Al Benitez\Documents\System, C:\Users\Al Benitez\Documents\Misc"
For i = 1 To UBound(Split(StrFolders, ",")) + 1
StrFolder = Trim(Split(StrFolders, ",")(i - 1))
ReDim Preserve ArrFolders(2, i)
ArrFolders(1, i) = StrFolder
ArrFolders(2, i) = CountFiles(StrFolder, StrType)
Next
End Sub
Note how the first version requires just the parent folder, whilst the second version requires a comma-separated list of folders.

Both of the above subs call the following function:

Function CountFiles(StrFold As Variant, StrFileType As String) As Variant
Dim StrFName As Variant, i As Integer
StrFName = Dir(StrFold & "\*." & StrFileType, vbNormal)
While StrFName <> ""
i = i + 1
StrFName = Dir()
Wend
CountFiles = i
End Function
You can test the subs with code like:

Sub Test1()
Dim i As Integer
StrType = "PDF"
Call Get_File_Counts1(StrType)
For i = 1 To UBound(ArrFolders, 2)
MsgBox "The folder named: " & vbCr & ArrFolders(1, i) _
& vbCr & "contains " & ArrFolders(2, i) & " " & StrType & " files"
Next
End Subfor the first version, or, for the second version:

Sub Test2()
Dim i As Integer
StrType = "PDF"
Call Get_File_Counts2(StrType)
For i = 1 To UBound(ArrFolders, 2)
MsgBox "The folder named: " & vbCr & ArrFolders(1, i) _
& vbCr & "contains " & ArrFolders(2, i) & " " & StrType & " files"
Next
End Sub

Bob Phillips
10-03-2009, 06:37 AM
MsgBox CreateObject("Scripting.FilesystemObject").getfolder("C:\test").Files.Count

Oorang
10-03-2009, 09:01 AM
XLD, I believe the OP said they needed to count just the PDFs.:clever:

Bob Phillips
10-03-2009, 10:01 AM
Sorry teach!



Const FILE_TYPE As String = "Adobe Acrobat"
Dim num As Long
Dim itm As Variant
Dim files As Object
Dim file As Object
Set files = CreateObject("Scripting.FilesystemObject").getfolder("C:\test").files
For Each file In files
num = num - (file.Type Like "*" & FILE_TYPE & "*")
Next file

MsgBox num

Oorang
10-04-2009, 04:27 PM
rofl:)