'patricktoulon liste fichier FSO (fonction récursif)
Sub testFSO()
Dim Racine$, tim, ext$
ReDim t(1) 'on dimentionne un array de 1 item pour commencer
Racine = "h:" ' disque à lister
tim = Timer
ext = "*.txt" ' une partie du nom et l'extension
recherche_récursive Racine, t, ext 'appel de la fonction t est injecté comme tel
MsgBox (Timer - tim) & " secondes ; " & UBound(t) & " fichiers avec FSO"
Cells(1, 1).Resize(UBound(t), 1) = Application.Transpose(t)
End Sub
'
'
Private Function recherche_récursive(dparent, t, Optional E As String = "*.*", Optional recall As Boolean = False) ' As Variant
Static FSO As Object
Dim Lparent As Object, SubFolder As Object, Ficher, a
If Not recall Then 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
'-------------------------------------------------------------
'condition garde fou pour fichier ou dossiers non autorisé
If Not Lparent Like "*RECYCLE*" And Not Lparent Like "BIN\" And Not Lparent Like "*System Volume Information*" Then
'----------------------------------------------------------------
If Dir(Lparent.Path & "\" & E) <> "" Then ' si le dossier contient des fichiers avec la partie (E) alors on le scrute
For Each Ficher In Lparent.Files 'on boucle sur les fichiers qui sont dans ce dossier
If Mid(Ficher, InStrRev(Ficher, "\")) Like E Then t(UBound(t) - 1) = Ficher: ReDim Preserve t(UBound(t) + 1): ' 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
If Dir(SubFolder.Path & "\" & E) <> "" Or SubFolder.subfolders.Count > 0 Then recherche_récursive SubFolder.Path, t, E, True ' on rappelle la fonction avec pour argument le chemin du sous dossier ainsi que le tableau(t) pour continuer a l'instruire
Err.Clear
Next SubFolder
End If
End If
'recherche_récursive = t 'a la fin la fonction devient le tableau (t)
End Function
en cabanon
.
