VBA VB6 - Lire tous les fichiers, répertoires et sous/rép

La fonction Scripting.FileSystemObject remplace avantageusement Application.FileSearch qui d'ailleurs, n'est plus disponible à partir d'Office 2007.
Un exemple pour mémoriser tous les fichiers images d'un répertoire.
À coller dans un module.bas :

Option Explicit        
Dim Data()        
Dim NBdata As Integer        

'Obtenir tous les fichiers d'un répertoire et éventuellement des sous-répertoires        
'Si SousRep = true        
'Le répertoire source doit être dans Rep        
Public Function LireRepertoir(ByVal Rep As String, Optional SousRep As Boolean) As Integer        
Dim Obj, RepP, F, S, sf, F1, Fsous        
Dim i As Integer, Ext As String        
Dim Chem As String        
Dim T As Double        
   ' Application.MousePointer = 13 'Pour VB6       
    Set Obj = CreateObject("Scripting.FileSystemObject")        
    Set RepP = Obj.Getfolder(Rep)        
    Chem = Rep: If Right(Chem, 1) <> "\" Then Chem = Chem & "\"        
            
    Set sf = RepP.subfolders        
    Set F = RepP.Files        
    GoSub RempliData 'les fichiers du répertoire principal        
    If SousRep Then 'les fichiers des sous-répertoires        
        For Each Fsous In sf        
            Set RepP = Fsous        
            Set F = RepP.Files        
            GoSub RempliData        
        Next Fsous        
    End If        
Exit Function        
'**********************************************************************        
RempliData:        
    For Each F1 In F        
        Ext = LCase(Right(F1.Name, 3))        
        If Ext = "bmp" Or Ext = "jpg" Then 'extension à adapter        
            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

Mémorise également les infos sur les fichiers.
À adapter en fonction des besoins. Ce document intitulé « VBA VB6 - Lire tous les fichiers, répertoires et sous/rép » issu de CommentCaMarche (www.commentcamarche.net) est mis à disposition sous les termes de la licence Creative Commons. Vous pouvez copier, modifier des copies de cette page, dans les conditions fixées par la licence, tant que cette note apparaît clairement.