Sub Obtenir_Nom_SousRepertoire()
'Afficher le nom des sous-repertoires de repertoire
Dim FSO As Object, L As Integer
Set FSO = CreateObject("Scripting.FileSystemObject")
L = 1
ThisWorkbook.Sheets("Feuil1").Cells.Clear
ThisWorkbook.Sheets("Feuil1").Range("A1") = "Myrep"
MyRep FSO, ThisWorkbook.Sheets("Feuil1"), "C:\Myrep", L + 1, 2
End Sub
Sub MyRep(ByVal FSO As Object, ByRef feuille As Worksheet, ByVal Rep As String, ByRef L As Integer, Optional C As Integer = 1)
With FSO.GetFolder(Rep)
For Each MySubfolder In .SubFolders 'Pour chaque sous-repertoire
feuille.Cells(L, C) = MySubfolder.Name 'Afficher le nom du sous-repertoire "D:\Test"
L = L + 1
MyRep FSO, feuille, MySubfolder.Path, L, C + 1
Next
If C > 1 Then MyFichier FSO, feuille, Rep, L, C
End With
C = C - 1
If C > 0 Then feuille.Cells(L, C) = "Fin " & IIf(Right(Rep, 1) = "\", Split(Rep, "\")(UBound(Split(Rep, "\")) - 1), Split(Rep, "\")(UBound(Split(Rep, "\")))): L = L + 1
End Sub
Sub MyFichier(ByVal FSO As Object, ByRef feuille As Worksheet, ByVal Rep As String, ByRef L As Integer, ByVal C As Integer)
With FSO.GetFolder(Rep) 'Liste les fichiers du répertoire
For Each NomFich In .Files
feuille.Cells(L, C) = NomFich.Name
L = L + 1
Next
End With
End Sub