Sub ListeFichiersAll()
TousLesDossiers "C:\Temp\", 1
DirFichiers
End Sub
Private Sub TousLesDossiers(LeDossier$, Idx As Long)
Dim Fso As Object, Dossier As Object
Dim sousRep As Object, Flder As Object
Set Fso = CreateObject("Scripting.FileSystemObject")
Set Dossier = Fso.GetFolder(LeDossier)
'examen du dossier courant
For Each Flder In Dossier.SubFolders
Idx = Idx + 1
Cells(Idx, 1).Value = Flder.Path
Next
'traitement récursif des sous dossiers
For Each sousRep In Dossier.SubFolders
TousLesDossiers sousRep.Path, Idx
Next sousRep
Set Fso = Nothing
End Sub 'fs
Private Sub DirFichiers()
For Each cell In Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row)
cell.Select
Fichiers
Next
End Sub
Private Sub Fichiers()
Application.ScreenUpdating = False
Dim myPath As String, myFile As String
myPath = ActiveCell.Value 'ThisWorkbook.Path
myFile = Dir(myPath & "\*.xls*")
c = 2
Do While myFile <> ""
'Cells(c, 1) = myFile
Cells(ActiveCell.Row, c) = myFile
myFile = Dir()
c = c + 1
Loop
End Sub