應用程式/遞迴資料夾檔案列表

概述

• 遞迴列表很棘手，如果沒有模組或公共宣告，就會發現很難實現。這個版本雖然有點笨拙，但對於可以訪問的檔案，它的執行效果將符合預期。
• 一個公共變數用作計數器，在迭代之間跟蹤找到的檔案數量，因為 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