VBA VB6 - Leer todos los archivos, carpetas y subcarpetas

Junio 2017


La función Scripting.FileSystemObject reemplaza ventajosamente a la función Application.FileSearch, que por otro lado ya no está disponible desde Office 2007.
Un ejemplo para almacenar todos los archivos de imágenes en una carpeta.
Pegar el código en un modulo .bas:

Option Explicit         
Dim Data()         
Dim NBdata As Integer         

`Obtener todos los archivos de una carpeta y subcarpetas
'Si SubCarp = true         
`La carpeta de origen debe estar en Carp
Public Function LeerCarpeta (ByVal Carp As String, Optional SubCarp As Boolean) As Integer         
Dim Obj, CarpP, F, S, sf, F1, Fsub      
Dim i As Integer, Ext As String         
Dim Ruta As String         
Dim T As Double         
   ' Application.MousePointer = 13 'Para VB6        
    Set Obj = CreateObject("Scripting.FileSystemObject")         
    Set RepP = Obj.Getfolder(Carp)         
    Chem = Carp: If Right(Ruta, 1) <> "\" Then Ruta = Ruta & "\"         
             
    Set sf = CarpP.subfolders         
    Set F = CarpP.Files         
    GoSub RellenarData 'los archivos de la carpeta principal         
    If SubCarp Then 'los archivos de las subcarpetas
        For Each FSub In sf         
            Set CarpP = Fsub         
            Set F = CarpP.Files         
            GoSub RellenarData         
        Next Fsub         
    End If         
Exit Function         
'**********************************************************************         
RellenarData:         
    For Each F1 In F         
        Ext = LCase(Right(F1.Name, 3))         
        If Ext = "bmp" Or Ext = "jpg" Then 'extensión a adaptar         
            ReDim Preserve Data(5, NBdata)         
            Data(0, NBdata) = F1.Name         
            Data(1, NBdata) = F1.ParentFolder & "\" & F1.Name         
            Data(2, NBdata) = F1.DateCreated         
            Data(3, NBdata) = F1.DateLastAccessed         
            Data(4, NBdata) = F1.DateLastModified         
            T = F1.Size         
            If T < 99999 Then         
                Data(5, NBdata) = T & " Bi"         
            ElseIf T < 999999 Then         
                Data(5, NBdata) = Round(T / 1000, 1) & " Ko"         
            Else         
                Data(5, NBdata) = Round(T / 1000000, 1) & " Mo"         
            End If         
            NBdata = NBdata + 1         
        End If         
    Next F1         
Return         
             
End Function


También es posible guardar información de los archivos
Adaptar el código de acuerdo a las necesidades.

Consulta también

Artículo original escrito por . Traducido por Carlos-vialfa. Última actualización: 14 de mayo de 2010 a las 00:21 por Carlos-vialfa.
El documento «VBA VB6 - Leer todos los archivos, carpetas y subcarpetas» se encuentra disponible bajo una licencia Creative Commons. Puedes copiarlo o modificarlo libremente. No olvides citar a CCM (es.ccm.net) como tu fuente de información.