Menu
Donnez votre avis

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

Posez votre question

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.
Ajouter un commentaire

Commentaires

Commenter la réponse de Utilisateur anonyme
VBA - Créer une série de boutons sur un feuille Excel
VBA VB6 - Forcer l'ouverture d'un ComboBox