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.
