vba 计算文件夹和子文件夹中的文件，用字符串排除文件夹

Count files in folder and subfolders, exlucing folders with string

提问by Gamah

Given a folder tree:

给定一个文件夹树：

c:\example\
c:\example14-01-01\
c:\example14-01-01\Entered\
c:\example14-01-02\
c:\example14-01-02\Entered
etc.

I want to count the PDF files in the tree, but excluding any in the "Entered\" subfolders.

我想计算树中的 PDF 文件，但不包括“已输入\”子文件夹中的任何文件。

Is this possible even with VBA? Ultimately this count needs to be spit out onto an excel sheet.

即使使用 VBA 这也可能吗？最终，这个计数需要被吐出到 Excel 表上。

回答by asif

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.

复制 Excel-VBA 模块中的所有代码。如果你想使用一个按钮，那么你应该CntFiles()在按钮上使用。但是，如果您不想使用按钮，则可以将其fCount(strPath)用作 Worksheet 上的公式，即=fCount("your-path")，参数为 String，因此在 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.

此代码将计算指定文件夹中的所有文件以及子文件夹，不包括您指定的名为“Entered”的文件夹。

回答by CDR

This code gives you a nice overview in an excel sheet:

此代码在 Excel 表中为您提供了一个很好的概述：

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