Question

给定文件夹树：

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

我想计算树中的PDF文件，但不包括＆＃34;输入的＆＃34;子文件夹。

即使使用VBA，这是否可行？最终这个计数需要吐到excel表上。

Answer 1

复制Excel-VBA模块中的所有代码。如果要使用按钮，则应使用按钮上的CntFiles()。但是，如果您不想使用按钮，那么您可以使用fCount(strPath)作为工作表上的公式，即=fCount("your-path")，参数为String，因此在工作表上使用时将其双引号。

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

此代码将计算指定文件夹中的所有文件以及指定名称为“已输入”的文件夹以外的子文件夹。

Answer 2

此代码在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

计算文件夹和子文件夹中的文件，不包括带字符串的文件夹

2 个答案: