应用程序/递归文件夹文件列表

概述

• 递归列表很棘手，如果没有模块或公共声明，就会发现很难实现。这个版本虽然有点笨拙，但对于可以访问的文件，它的执行效果将符合预期。
• 一个公共变量用作计数器，在迭代之间跟踪找到的文件数量，因为 Microsoft 建议我们不要在递归中使用静态变量。VBA 代码不特定于任何特定的 Office 应用程序，因此可以在 MS Excel 或 MS Word 等中使用。
• 用户可能需要引入更多过滤；例如，排除某些文件类型，或避免大小为零的文件。代码清单中的注释显示了可以在现有条件下添加此类代码函数的位置。
• 由于该数组是公共的，因此可以从任何其他模块访问它，以进行进一步处理或输出。将代码完整复制到代码模块中，并将文件夹和递归条件修改为自己的值。
• 我的文档与文档。库中有四个虚拟文件夹，我的文档、我的音乐、我的图片和我的视频。当 Windows 资源管理器的文件夹选项禁止显示隐藏文件、文件夹和驱动器时，各种文件夹选择对话框将返回正确的地址，即文档、音乐、图片和视频。当允许隐藏文件夹时，对话框和列表将尝试使用这些虚拟路径。将导致访问冲突。为了避免不必要的麻烦，请检查您的文件夹选项是否设置为不显示隐藏文件或文件夹。此过程完全避免了这些文件夹，但是可以避免访问冲突，前提是允许隐藏文件保持隐藏状态。

VBA 代码

Option Explicit
Option Base 1

Public vA() As String
Public N As Long


Sub MakeList()
    'loads an array with details of the files in the selected folder.
    
    Dim sFolder As String, bRecurse As Boolean
    
    'NOTE
    'The Windows virtual folders My Music, My Videos, and My Pictures
    'generate (handled) error numbers 70,90,91 respectively, so are avoided.
    'Alternatively, set Folder Options to not show hidden files and folders
    'to avoid the problem.
    
    'set folder and whether or not recursive search applies
    sFolder = "C:\Users\My Folder\Documents\Computer Data\"
    bRecurse = True

    'erase any existing contents of the array
    Erase vA()  'public string array
        
    'this variable will accumulate the result of all recursions
    N = 0 'initialize an off-site counting variable
            
    'status bar message for long runs
    Application.StatusBar = "Loading array...please wait."
    
    'run the folder proc
    LoadArray sFolder, bRecurse
        
    If N = 0 Then
       Application.StatusBar = "No Files were found!"
       MsgBox "NO FILES FOUND"
       Application.StatusBar = ""
       Exit Sub
    Else
       'status bar message for long runs
       Application.StatusBar = "Done!"
       MsgBox "Done!" & vbCrLf & N & " Files listed."
       Application.StatusBar = ""
       Exit Sub
    End If

End Sub

Sub LoadArray(sFolder As String, bRecurse As Boolean)
    'loads dynamic public array vA() with recursive or flat file listing
       
    'The Windows folders My Music, My Videos, and My Pictures
    'generate error numbers 70,90,91 respectively, and are best avoided.
    
    Dim FSO As Object, SourceFolder As Object, sSuff As String, vS As Variant
    Dim SubFolder As Object, FileItem As Object, sPath As String
    Dim r As Long, Count As Long, m As Long, sTemp As String
    
    'm counts items in each folder run
    'N (public) accumulates m for recursive runs
    m = m + N
        
    On Error GoTo Errorhandler
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set SourceFolder = FSO.GetFolder(sFolder)
    
    For Each FileItem In SourceFolder.Files
        DoEvents
        sTemp = CStr(FileItem.Name)
        sPath = CStr(FileItem.path)
        
        'get suffix from fileitem
        vS = Split(CStr(FileItem.Name), "."): sSuff = vS(UBound(vS))
        
        If Not FileItem Is Nothing Then 'add other file filter conditions to this existing one here
            m = m + 1 'increment this sourcefolder's file count
            'reset the array bounds
            ReDim Preserve vA(1 To 6, 0 To m)
            r = UBound(vA, 2)
                'store details for one file on the array row
                vA(1, r) = CStr(FileItem.Name)
                vA(2, r) = CStr(FileItem.path)
                vA(3, r) = CLng(FileItem.Size)
                vA(4, r) = CDate(FileItem.DateCreated)
                vA(5, r) = CDate(FileItem.DateLastModified)
                vA(6, r) = CStr(sSuff)
        End If
    Next FileItem
    
    'increment public counter with this sourcefolder count
    N = m  'N is public
    
    'this bit is responsible for the recursion
    If bRecurse Then
        For Each SubFolder In SourceFolder.SubFolders
            LoadArray SubFolder.path, True
        Next SubFolder
    End If
       
    Set FileItem = Nothing
    Set SourceFolder = Nothing
    Set FSO = Nothing
    Exit Sub

Errorhandler:
    If Err.Number <> 0 Then
        Select Case Err.Number
        Case 70 'access denied
            'MsgBox "error 70"
            Err.Clear
            Resume Next
        Case 91 'object not set
            'MsgBox "error 91"
            Err.Clear
            Resume Next
        Case Else
            'MsgBox "When m = " & m & " in LoadArray" & vbCrLf & _
            "Error Number :  " & Err.Number & vbCrLf & _
            "Error Description :  " & Err.Description
            Err.Clear
            Exit Sub 'goes to next subfolder - recursive
        End Select
    End If

End Sub