Option Explicit
Private FSO As New FileSystemObject
Private Sub CommandButton1_Click()
Dim Chemin As String, NomFic As String, CLnDoss As Collection, _
Doss As Folder, F As File, T(1 To 20000, 1 To 6), L As Long
With Application.FileDialog(msoFileDialogFolderPicker)
.AllowMultiSelect = False
.Show
If .SelectedItems.Count = 0 Then Exit Sub
Set CLnDoss = SousDoss(FSO.GetFolder(.SelectedItems(1)))
End With
On Error Resume Next
For Each Doss In CLnDoss
For Each F In Doss.Files
L = L + 1: T(L, 1) = F.Name: T(L, 2) = Split(F.Name & ".", ".")(1): T(L, 3) = F.Size
T(L, 4) = F.DateCreated: T(L, 5) = F.DateLastModified
T(L, 6) = F.Path: Next F, Doss
Me.[A3].Resize(UBound(T, 1), UBound(T, 2)).Value = T
End Sub
Function SousDoss(ByVal Doss As Folder) As Collection
Dim SDos As Folder
Set SousDoss = New Collection
SousDoss.Add Doss
On Error Resume Next
If Doss.SubFolders.Count = 0 Then Exit Function
If Err Then Exit Function
For Each Doss In Doss.SubFolders
For Each SDos In SousDoss(Doss)
SousDoss.Add SDos
Next SDos, Doss
End Function