Option Compare Text
Option Explicit
Function CountFiles(Directory As String, Optional Ext As String = "All") As Double
Dim fs As Object, i As Integer
Set fs = Application.FileSearch
If Len(Ext) < 3 Then Ext = "All"
With fs
.LookIn = Directory
.FileType = GetMSOFileType(Ext)
.Execute
If Ext = "All" Then
CountFiles = .FoundFiles.Count
Else
For i = 1 To .FoundFiles.Count
If Right(.FoundFiles.Item(i), 3) = Right(Ext, 3) Then _
CountFiles = CountFiles + 1
Next i
End If
End With
Set fs = Nothing
End Function
Function GetMSOFileType(FileExt As String) As Double
Select Case Right(FileExt, 3)
Case Is = "doc", "dot"
GetMSOFileType = 3
Case Is = "xls", "xla", "xlt", "xlc", "xlm"
GetMSOFileType = 4
Case Is = "ppt", "pps", "pot"
GetMSOFileType = 5
Case Is = "mdb", "mde", "ade", "adp"
GetMSOFileType = 7
Case Is = "pub"
If Val(Application.Version) < 10 Then
GetMSOFileType = 1
Else
GetMSOFileType = 18
End If
Case Is = "vsd", "vss", "vst"
If Val(Application.Version) < 10 Then
GetMSOFileType = 1
Else
GetMSOFileType = 21
End If
Case Is = "htm", "tml", "mht"
If Val(Application.Version) < 10 Then
GetMSOFileType = 1
Else
GetMSOFileType = 23
End If
Case Else
GetMSOFileType = 1
End Select
End Function
|