Option Explicit
Private TRés(), LCou As Long, FSO As New FileSystemObject
Sub ListeFic()
Dim NomDoss As String
NomDoss = ActiveSheet.Cells(1, "A").Value
If FSO.FolderExists(NomDoss) Then
ReDim TRés(1 To 10000, 1 To 2)
LCou = 0
Lister FSO.GetFolder(NomDoss)
ActiveSheet.Rows(3).Resize(10000).Delete
ActiveSheet.[A3].Resize(LCou, 2).Value = TRés
Erase TRés
Else
MsgBox "Dossier """ & NomDoss & """ inexistant.", vbCritical, "ListeFic"
End If
End Sub
Private Sub Lister(ByVal Fdr As Scripting.Folder)
Dim ChemDoss As String, FdrS As Scripting.Folder, Fle As Scripting.File
If Fdr.Attributes >= 1024 Then Exit Sub
ChemDoss = Fdr.Path
For Each Fle In Fdr.Files
LCou = LCou + 1
TRés(LCou, 1) = ChemDoss
TRés(LCou, 2) = Fle.Name
Next Fle
For Each FdrS In Fdr.SubFolders
Lister FdrS: Next FdrS
End Sub