文件系统扫描

经常用到递归扫描文件，虽然简单，如果多用几处显得挺繁琐的，本文旨在创作一个通用的文件扫描封装类，封装扫描控制，抛出Get到的文件系统对象。

需求

能指定扫描要获取的对象，可能是文件、可能是文件夹，可能二者都要
能控制递归
能随时取消正在进行的扫描

实现

创建类FileSysAuto.cls

Option Explicit
'***************************************************
'
'               文件系统扫描
'
'***************************************************

'扫描目的
Public Enum ScanPurpose
    GET_FILE = 1     '获取文件
    GET_FOLDER = 2   '获取文件夹
End Enum

'找到目标时抛出的事件
'obj:找到的对象，是文件或文件夹
'Index:序号，找到的第几个对象
'bCancel:是否取消扫描
Event Found(obj As Object, ByVal Index As Long, bCancel As Boolean)

Dim fsox As New FileSystemObject
Dim mCounter As Long '计数器

'扫描文件夹
'sFolderPath:待扫描的文件夹路径
'enumScanMethod:扫描方式
'bRecursively:是否用递归扫描
Public Sub ScanFolders(ByVal sFolderPath As String, enumScanPurpose As ScanPurpose, Optional bRecursively As Boolean)
    If fsox.FolderExists(sFolderPath) = False Then Exit Sub
    mCounter = 0
    ScanFoldersEx fsox.GetFolder(sFolderPath), enumScanPurpose, bRecursively
End Sub
Private Sub ScanFoldersEx(fdRoot As Folder, enumScanPurpose As ScanPurpose, bRecursively As Boolean)
    Dim bCancel As Boolean
    Dim fd As Folder
    
    '当前目录下的文件
    If (enumScanPurpose And GET_FILE) = GET_FILE Then
        Dim fl As File
        For Each fl In fdRoot.Files
            mCounter = mCounter + 1
            RaiseEvent Found(fl, mCounter, bCancel)
            If bCancel Then Exit Sub
        Next
    End If
    
    '当前目录下的文件夹
    If (enumScanPurpose And GET_FOLDER) = GET_FOLDER Then
        For Each fd In fdRoot.SubFolders
            mCounter = mCounter + 1
            RaiseEvent Found(fd, mCounter, bCancel)
            If bCancel Then Exit Sub
        Next
    End If
    
    DoEvents
    
    '递归
    If bRecursively Then
        For Each fd In fdRoot.SubFolders
            ScanFoldersEx fd, enumScanPurpose, bRecursively
        Next
    End If
End Sub

用法

用WithEvents定义一个FileSysAuto类的实例

Option Explicit
Dim WithEvents oFileSysAuto As FileSysAuto

Private Sub Form_Load()
    Set oFileSysAuto = New FileSysAuto
    
    'DEMO1:获取D:\test目录下的文件和文件夹，不钻取（递归）
    oFileSysAuto.ScanFolders "D:\test", GET_FILE + GET_FOLDER, False
    
    'DEMO2:递归获取D:\test目录下的文件
    oFileSysAuto.ScanFolders "D:\test", GET_FILE, True
    
    'DEMO3:递归获取D:\test目录下的文件和文件夹
    oFileSysAuto.ScanFolders "D:\test", GET_FILE + GET_FOLDER, True
End Sub

Private Sub oFileSysAuto_Found(obj As Object, ByVal Index As Long, bCancel As Boolean)
    Dim sLog As String
    sLog = "扫描到第" & Format(Index, "#,###") & "个对象，"

    If TypeName(obj) = "Folder" Then
        Dim fd As Folder
        Set fd = obj
        sLog = "它是文件夹" & fd.Path
    Else
        Dim fl As File
        Set fl = obj
        sLog = "它是文件" & fl.Path
    End If
    
    Debug.Print sLog
    
'    '取消扫描
'    bCancel = True
End Sub