Public idx As Double, Lecteur
Sub Liste_Dossiers_Seuls()
t1 = Timer
On Error Resume Next
idx = 2
Application.ScreenUpdating = False
Sheets.Add
'Lecteur = InputBox("lecteur à scanner?")
'TousLesDossiersSeuls Lecteur & ":\", 0
Lecteur = InputBox("Dossier à scanner?")
TousLesDossiersSeuls Lecteur & "\", 0
derl = [A65536].End(xlUp).Row
Range(Cells(1, 1), Cells(derl, 1)).Select
Application.ScreenUpdating = True
Application.StatusBar = Format(Timer - t1, "0,0" & " secondes pour Lister les dossiers")
End Sub
Sub TousLesDossiersSeuls(LeDossier$, idx As Long)
Dim FSO As Object, Dossier As Object
Dim sousRep As Object, Flder As Object
Dim Fichier As Object, Chemin As String
On Error Resume Next
Application.ScreenUpdating = False
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
TousLesDossiersSeuls sousRep.Path, idx
'idx = idx + 1
Next
Set FSO = Nothing
End Sub