VBA Access. Módulo de clase clsFileList. Obtiene listado de ficheros, carpetas y el número total de ficheros y carpetas encontrados. La búsqueda puede ser recursiva o no.

Option Compare Database
Option Explicit

'#########################################################################################################################################
'GetFileList(Folder,Optional bRecursive=true)
'Obtiene la lista de ficheros y carpetas recursivamente de una carpeta / La búsqueda recursiva es opcional
'Si GetFileList = False, han habido errores y los resultados obtenidos no son fiables (por ejemplo un error de permiso de acceso denegado)
'
'Ejemplo de uso:
'Dim res As Boolean
'Dim oFileList As New clsFileList
'res = oFileList.GetFileList("C:\Temp")
'Debug.Print "#Folders : " & UBound(oFileList.Folders)
'Debug.Print "FoldersCount: " & oFileList.FoldersCount
'Debug.Print "#Files : " & UBound(oFileList.Files)
'Debug.Print "FilesCount: " & oFileList.FilesCount
'Set oFileList = Nothing
'
'Tip: Comprobar si un array está vacío
'(not arrayName) = -1
'#########################################################################################################################################

Private m_Folder As String

Private m_Files() As String
Private m_FilesCount As Long
Private m_FoldersCount As Long
Private m_Folders() As String

Private Sub Class_Initialize()
    'initialize values
    FilesCount = 0
    FoldersCount = 0
End Sub

Private Sub Class_Terminate()
    'deallocate if needed
End Sub

Public Sub InitiateProperties(ByRef ArrayFolders() As String, ByVal FoldersCount As Long, ByRef ArrayFiles() As String, ByVal FilesCount As Long)
On Error GoTo error
    ReDim Preserve m_Files(UBound(ArrayFiles))
    m_Files = ArrayFiles
    m_FilesCount = FilesCount

    ReDim Preserve m_Folders(UBound(ArrayFolders))
    m_Folders = ArrayFolders
    m_FoldersCount = FoldersCount
Exit Sub
error:
    Debug.Print Err.Description
End Sub

Public Property Get Files()
    Files = m_Files
End Property

Public Property Get FilesCount() As Long
    FilesCount = m_FilesCount
End Property

Public Property Let FilesCount(ByVal Value As Long)
    m_FilesCount = Value
End Property

Public Property Get Folders()
    Folders = m_Folders
End Property

Public Property Get FoldersCount() As Long
    FoldersCount = m_FoldersCount
End Property

Public Property Let FoldersCount(ByVal Value As Long)
    m_FoldersCount = Value
End Property

Public Property Get Folder() As String
    Folder = m_Folder
End Property

Public Property Let Folder(ByVal Value As String)
    m_Folder = Value
End Property

Public Function GetFileList(ByVal Folder As String, Optional ByVal bRecursivo As Boolean = True) As Boolean
On Error GoTo error
    Dim objFSO As Object
    Dim objFolder As Object
    Dim objSubFolder As Object
    Dim objFile As Object

    Dim res As Boolean
    Dim resR As Boolean
    res = True
    resR = True
   
    Debug.Print Folder & vbNewLine

    If Dir(Folder, vbDirectory) <> "" Then
        'root folder not included
        If (Not m_Folders) <> -1 Then
            'Add folder to array
            m_Folders(UBound(m_Folders)) = Folder
        End If
    End If
   
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objFolder = objFSO.GetFolder(Folder)

    'Add files to array and count them
    For Each objFile In objFolder.Files
        If (Not m_Files) = -1 Then
            ReDim Preserve m_Files(1)
        Else
            ReDim Preserve m_Files(UBound(m_Files) + 1)
        End If

        'Count files
        FilesCount = UBound(m_Files)

        'Add file to array
        m_Files(FilesCount) = objFile.path
        Debug.Print vbTab & objFile.path & vbNewLine

    Next objFile

    'loops through each folder in the directory
    For Each objSubFolder In objFolder.SubFolders
        'Count folders
        FoldersCount = FoldersCount + 1

        'recursive search
        If bRecursivo Then
            Dim SubFolders() As String
            Dim oFileList As New clsFileList
           
            If (Not m_Folders) = -1 Then
                '1st item
                ReDim Preserve m_Folders(1)
            Else
                ReDim Preserve m_Folders(UBound(m_Folders) + 1)
            End If
           
            oFileList.InitiateProperties m_Folders, UBound(m_Folders), m_Files, m_FilesCount
            resR = oFileList.GetFileList(objSubFolder.path, bRecursivo)
           
            m_Files = oFileList.Files
            FilesCount = oFileList.FilesCount
            m_Folders = oFileList.Folders
            FoldersCount = oFileList.FoldersCount
           
            Set oFileList = Nothing
        End If
       
        res = res And resR

        DoEvents
    Next objSubFolder

    Set objFolder = Nothing
    Set objSubFolder = Nothing
    Set objFile = Nothing
    Set objFSO = Nothing

    GetFileList = res

Exit Function
Resume
error:
    GetFileList = False
    Debug.Print vbTab & ">>>> " & "Error " & Err.Number & ", " & Err.Description & " <<<<"
End Function