Sub testQ()
Dim racine$, tim
ReDim t(1 To 1) 'on dimentionne un array de 1 item pour commencer
racine = "H:" ' disque à lister
tim = Timer
recherche_récursive racine, t 'appel de la fonction t est injecté comme tel
MsgBox (Timer - tim) & " secondes ; " & UBound(t) & " fichiers"
Cells(1, 1).Resize(UBound(t), 1) = Application.Transpose(t)
End Sub
'
'
Private Function recherche_récursive(dparent, t, Optional L As String) ' As Variant
Dim FSO As Object, Lparent As Object, SubFolder As Object, Ficher, a
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
'----------------------------------------------------------------
For Each Ficher In Lparent.Files 'on boucle sur les fichiers qui sont dans ce dossier
a = UBound(t) + 1: ReDim Preserve t(1 To a): t(a) = Ficher ' on redim preserve le tableau(t) avec un item de plus et on instruit l'item avec le chemin de fichier trouvé
Next
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é
recherche_récursive SubFolder.Path, t, L ' on rappelle la fonction avec pour argument le chemin du sous dossier ainsi que le tableau(t) pour continuer a l'instruire
Next SubFolder
End If
'recherche_récursive = t 'a la fin la fonction devient le tableau (t)
End Function
'--------------------------------------------------------
Sub testzzzzz()
Dim racine$, tim
ReDim t(1 To 1) 'on dimentionne un array de 1 item pour commencer
racine = "H:" ' disque à lister
tim = Timer
recherche_récursive2 racine, t, ".txt" 'appel de la fonction t est injecté comme tel
MsgBox (Timer - tim) & " secondes ; " & UBound(t) & " fichiers"
Cells(1, 1).Resize(UBound(t), 1) = Application.Transpose(t)
End Sub
'
'
Private Function recherche_récursive2(dparent, t, Optional ext As String = "*") ' As Variant
Dim FSO As Object, Lparent As Object, SubFolder As Object, Ficher, a
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
'----------------------------------------------------------------
For Each Ficher In Lparent.Files 'on boucle sur les fichiers qui sont dans ce dossier
If Right(Ficher, Len(ext)) Like ext Then a = UBound(t) + 1: ReDim Preserve t(1 To a): t(a) = Ficher ' on redim preserve le tableau(t) avec un item de plus et on instruit l'item avec le chemin de fichier trouvé
Next
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é
recherche_récursive SubFolder.Path, t, ext ' on rappelle la fonction avec pour argument le chemin du sous dossier ainsi que le tableau(t) pour continuer a l'instruire
Next SubFolder
End If
'recherche_récursive = t 'a la fin la fonction devient le tableau (t)
End Function
