VBA自定义函数：统计指定扩展名的文件数量

标签：VBA，自定义函数

下面是整理自网上的一些统计文件数量的代码，供参考。

一个VBA自定义函数，可用于统计文件夹中的文件数，特别是指定扩展名的文件数。函数代码如下：

代码语言：javascript复制

' 目的: 统计文件夹中的文件数.
' 如果提供了文件扩展名, 则仅统计这种类型的文件
' 否则返回所有文件数.
Function CountFiles(strDirectory As String, Optional strExt As String = "*.*") As Double
 Dim objFso As Object
 Dim objFiles As Object
 Dim objFile As Object
 
 '设置错误处理
 On Error GoTo EarlyExit
 
 '创建对象以获取文件夹中的文件数
 Set objFso = CreateObject("Scripting.FileSystemObject")
 Set objFiles = objFso.GetFolder(strDirectory).Files
 '统计文件数 (如果提从则匹配扩展名)
 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:
 '整理
 On Error Resume Next
 Set objFile = Nothing
 Set objFiles = Nothing
 Set objFso = Nothing
 On Error GoTo 0
End Function

可以使用下面的代码来测试：

代码语言：javascript复制

Sub test()
 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

还可以使用更简洁一些的代码：

代码语言：javascript复制

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

使用下面的代码测试：

代码语言：javascript复制

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

更简洁的代码来了：

代码语言：javascript复制

Sub testSimpler()
 Dim fld As String
 Dim lst As Variant
 
 fld = "C:test*.xl*"
 lst = Filter(Split(CreateObject("wscript.shell").exec("cmd /c Dir" & fld & " /b /a-d").stdout.readall, vbCrLf), ".")
 MsgBox UBound(lst)   1
End Sub

统计C盘指定文件夹test中Excel文件的数量。

如果文件夹名字中有空格，则上述代码修改为：

代码语言：javascript复制

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

有兴趣的朋友可以根据自己的实际情况试试。

统计 vba set 测试 函数

0 人点赞