'patricktoulon liste fichier FSO (fonction récursif)
Sub testFSO()
Dim Racine$, tim, ext$, tbl 'on dimentionne un array de 1 item pour commencer
Racine = "h:" ' disque à lister
tim = Timer
ext = "*.txt" ' une partie du nom et l'extension
tbl = recherche_récursive(Racine) ', ext 'appel de la fonction t est injecté comme tel
MsgBox (Timer - tim) & " secondes ; " & UBound(tbl) & " fichiers avec FSO"
Cells(1, 1).Resize(UBound(tbl), 1) = tbl
End Sub
'
'
Private Function recherche_récursive(dparent, Optional E As String = "*.*", Optional recall As Boolean = False, Optional foldercount As Long = 0) ' As Variant
Static FSO As Object
Static t()
Dim Lparent As Object, SubFolder As Object, Ficher
If Not recall Then ReDim t(0): Set FSO = CreateObject("scripting.filesystemobject") ' on declare l'object
Set Lparent = FSO.GetFolder(dparent) ' regard sur les fichiers 'on attribue a l'object.getfolder le dossier demandé 'Scripting.Folder
foldercount = foldercount + Lparent.subfolders.Count ' et on rajoute le subfolders.count
If Dir(Lparent.Path & "\" & E) <> "" Then
For Each Ficher In Lparent.Files 'on boucle sur les fichiers qui sont dans ce dossier
If Mid(Ficher, InStrRev(Ficher, "\")) Like E Then ReDim Preserve t(UBound(t) + 1): t(UBound(t) - 1) = Ficher: ' on redim preserve le tableau(t) avec un item de plus et on instruit l'item avec le chemin de fichier trouvé
Next
End If
If Lparent.subfolders.Count Then
For Each SubFolder In Lparent.subfolders 'on boucle sur les dossiers qui sont dans ce dossiers
'a = UBound(t) + 1: ReDim Preserve t(1 To a): t(a) = SubFolder.Path 'SI ON LISTE AUSSI LES DOSSIERS , on redim preserve le tableau(t) avec un item de plus et on instruit l'item avec le chemin de dossier trouvé
On Error Resume Next ' pour gérer les dossier interdits
'si il y a des fichiers correspondant a la recherche ou si il y a encore un/des sousdossiers dans ce subfolder on relance
If Dir(SubFolder.Path & "\" & E) <> "" And Not SubFolder.Path Like "*RECYCLE*" Or SubFolder.subfolders.Count > 0 Then recherche_récursive SubFolder.Path, E, True, foldercount ' on rappelle la fonction avec pour argument le chemin du sous dossier ainsi que le tableau(t) pour continuer a l'instruire et le part of (nom/ext)
foldercount = foldercount - 1 'a chaque appel recursif on enleve 1
Err.Clear
Next SubFolder
End If
If foldercount = 0 Then
ReDim tbl(UBound(t), 1 To 1)
For i = LBound(t) To UBound(t): tbl(i, 1) = t(i): Next
recherche_récursive = tbl
End If
End Function
