Dim ligne 'Variable globale qui contient le n° de ligne ou on veut écrire
'Fonction qui récupère l'arborescence d'un répertoire dans un objet FileSystemObject
Sub arborescenceRepertoire()
racine = ChoixDossier() 'On choisit le répertoire initial grâce à la fonction ChoixDossier() (voir ci-dessous)
If racine = "" Then Exit Sub 'Si aucun répertoire initial n'est chois, on s'arrête là !
Range("A:Z").ClearContents 'On efface le contenu de toutes les cellules des colonnes A à Z
Set fs = CreateObject("Scripting.FileSystemObject") 'On crée l'objet FileSystemObject
Set dossier_racine = fs.getfolder(racine) 'Et on le remplit avec l'arborescence du répertoire initial grâce à la méthode "getfolder" de l'objet FileSystemObject
ligne = 3 'Puis on lance la focntion qui va afficher son contenu dans la feuille Excel active
Lit_dossier dossier_racine, 1
End Sub
'Fonction récursive qui écrit l'arborescence contenu dans un objet FileSystemObject
'On lui passe en paramètre l'objet FileSystemObject et un niveau de départ
Sub Lit_dossier(ByRef dossier, ByVal niveau)
Cells(ligne, niveau) = dossier.Name 'On écrit dans cellule ligne / niveau (Ex : A1 pour un premier répertoire, B2,B3,B4 pour ses "enfants", etc...
Cells(ligne, niveau).Font.ColorIndex = 0 'On s'assure que la police de caractère est de couleur noire
ligne = ligne + 1 'On passe à la ligne suivante
For Each f In dossier.Files 'Pour chaque entrée de l'objet FileSystemObject
Cells(ligne, niveau + 1) = f.Name 'On écrit son nom
Cells(ligne, niveau + 1).Font.ColorIndex = 3 'En rouge
ligne = ligne + 1
Next
For Each d In dossier.SubFolders 'Si l'entrée de l'objet FileSystemObject contient des "enfants"
Lit_dossier d, niveau + 1 'On relance cette même fonction pourchacun des enfants avec un de rang supérieur
Next
End Sub
'Fonction qui retourne le dossier choisi sous forme d'une chaîne de caractères
'Retourne "" si le bouton anuler
Function ChoixDossier()
If Val(Application.Version) >= 10 Then 'Si Excel supérieur à version 10, on utilise l'objet FileDialog
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = ActiveWorkbook.Path & "\" 'On règle le répertoire initial de l'objet FileDialog = répertoire du fichier courant
.Show 'On affiche le FileDialog
If .SelectedItems.Count > 0 Then 'Si on a choisi 1 répetoire (ou plus...)
ChoixDossier = .SelectedItems(1) 'On retourne le 1er répertoire sélectionné
Else
ChoixDossier = "" 'Sinon on retourne une chaîne vide
End If
End With
Else 'Si Excel inférieur à version 10, on utilise une simple InputBox
ChoixDossier = InputBox("Répertoire?") 'On retourne le contenu de l'InputBox
End If
End Function