Sub ListeRNTDFichiers()
Dim i%, j%, k%, Chemin$
Dim WBk As Workbook
Dim F As Worksheet
Set WBk = ThisWorkbook
Set F = WBk.Sheets(1)
Chemin = "C:\Temp\"
Application.ScreenUpdating = False
With Application.FileSearch
.LookIn = Chemin
.Filename = "*.xls"
If .Execute > 0 Then
For k = 1 To .FoundFiles.Count
If .FoundFiles(k) <> ThisWorkbook.FullName Then
F.Range("A65536").End(xlUp).Offset(1, 0) = _
Split(.FoundFiles(k), "\")(1)
F.Range("B65536").End(xlUp).Offset(1, 0) = _
Split(.FoundFiles(k), "\")(2)
F.Range("C65536").End(xlUp).Offset(1, 0) = _
FileLen(.FoundFiles(k))
F.Range("D65536").End(xlUp).Offset(1, 0) = _
FileDateTime(.FoundFiles(k))
End If
Next k
End If
End With
For j = 0 To 3
Cells(1, j + 1) = _
Split("Répertoire|Nom Fichier|Taille|Date Création/Modification", "|")(j)
Next
Columns("A:D").ColumnWidth = 26
With Range("A1:D1")
.Interior.ColorIndex = 9
.Font.ColorIndex = 2
.Font.Bold = True
End With
'Sheets(1).Activate
Application.ScreenUpdating = True
End Sub