前往小程序,Get更优阅读体验!
立即前往
首页
学习
活动
专区
工具
TVP
发布
社区首页 >专栏 >VBA自定义函数:统计指定扩展名的文件数量

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

作者头像
fanjy
发布2024-06-05 18:28:19
740
发布2024-06-05 18:28:19
举报
文章被收录于专栏:完美Excel完美Excel

标签: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)

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

本文参与 腾讯云自媒体同步曝光计划,分享自微信公众号。
原始发表:2024-06-04,如有侵权请联系 cloudcommunity@tencent.com 删除

本文分享自 完美Excel 微信公众号,前往查看

如有侵权,请联系 cloudcommunity@tencent.com 删除。

本文参与 腾讯云自媒体同步曝光计划  ,欢迎热爱写作的你一起参与!

评论
登录后参与评论
0 条评论
热度
最新
推荐阅读
相关产品与服务
腾讯云服务器利旧
云服务器(Cloud Virtual Machine,CVM)提供安全可靠的弹性计算服务。 您可以实时扩展或缩减计算资源,适应变化的业务需求,并只需按实际使用的资源计费。使用 CVM 可以极大降低您的软硬件采购成本,简化 IT 运维工作。
领券
问题归档专栏文章快讯文章归档关键词归档开发者手册归档开发者手册 Section 归档