'*********************************************************************************
'liste fichier dans dossier et sous dossier la racine peut etre un disque complet
'fonction recursive <<DirList>> avec Dir
'auteur patricktoulon
'date; 05/04/2013
'mise ajour pour demandes particulieres
'date;17/12/2021
'transformation array en tableau 2 dims et ajout de la date et le poids du fichier
'********************************************************************************
Private Sub CommandButton1_Click()
With Sheets("Index Docs").Range("C15")
.CurrentRegion.ClearContents '<<<Attention!!!!!si autres tableau trop proche choisir autre méthodes >>>
t = DirList(ThisWorkbook.Path & "\2-Client\")
If UBound(t) > 0 Then .Resize(UBound(t), 3) = t
End With
End Sub
Function DirList(Dossier As String, Optional recall As Boolean = False, Optional tbl As Variant) As Variant
Dim ItemVu As String, directory As Variant, SubFolderCollection As Collection, I As Long, A As Long, E As Long
Set SubFolderCollection = New Collection
If recall = False Then ReDim tbl(0) ' si recall on redim un tableau de zero item (pour la creation du tableau)
On Error Resume Next 'gestion des fichiers dossiers system et interdit ou generant une erreur(PerLog,recycle,caractères particuliers,nom trop long ,etc..)
ItemVu = Dir(Dossier, vbDirectory)
If Error.Number = 0 Then ' si pas d'erreur on examine le contenu
Do Until ItemVu = vbNullString 'examen du dossier courrant
If Left(ItemVu, 1) <> "." Then
If (GetAttr(Dossier & ItemVu) And vbDirectory) = vbDirectory Then
SubFolderCollection.Add ItemVu
Else
A = UBound(tbl) + 1: ReDim Preserve tbl(1 To A): tbl(A) = Dossier & ItemVu
End If
End If
ItemVu = Dir()
Loop
Else
Err.Clear
End If
For Each subdossier In SubFolderCollection 'examen des sub dossier
'A = UBound(tbl) + 1: ReDim Preserve tbl(1 To A): tbl(A) = Dossier & subdossier' si on veut lister les dossier aussi
DirList Dossier & subdossier & "\", True, tbl
Next subdossier
ReDim t(1 To UBound(tbl), 1 To 3)
For I = 1 To UBound(t)
t(I, 1) = Dir(tbl(I))
t(I, 2) = FileDateTime(tbl(I))
t(I, 3) = FileLen(tbl(I)) / 1000
t(I, 3) = t(I, 3) & IIf(t(I, 3) < 1000, " Ko", " Mo")
Next
DirList = t
End Function
