Cherche le moyen de créer une arborescence de fichier via Excel

tototiti2008 à dit:

Bonjour manubz,

Bienvenue sur XLD

L'idée est de recréer l'arborescence en scannant les disques ?
Si oui, sans doute des pistes par là
Gestion des fichiers et répertoires

Cliquez pour agrandir...

Dim ligne
Sub arborescenceRepertoire()
racine = ChoixDossier() ' ou un répertoire C:\xxx e.g.
If racine = "" Then Exit Sub
Range("A:E").ClearContents
Set fs = CreateObject("Scripting.FileSystemObject")
Set dossier_racine = fs.getfolder(racine)
ligne = 3
Lit_dossier dossier_racine, 1
End Sub

Sub Lit_dossier(ByRef dossier, ByVal niveau)
Cells(ligne, 1) = String(3 * (niveau - 1), " ") & dossier.Name
ligne = ligne + 1
For Each d In dossier.SubFolders
Lit_dossier d, niveau + 1
Next
End Sub

Function ChoixDossier()
If Val(Application.Version) >= 10 Then
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = ActiveWorkbook.Path & "\"
.Show
If .SelectedItems.Count > 0 Then
ChoixDossier = .SelectedItems(1)
Else
ChoixDossier = ""
End If
End With
Else
ChoixDossier = InputBox("Répertoire?")
End If
End Function

Cliquez pour agrandir...

Efgé à dit:

Bonjour manubz et bienvenu sur le forum
Un fichier qui liste les sous dossier et fichiers d'un répertoire.
Cliquer sur Repertoire à explorer
Le code est bien commenté (Alt + F11)
Je ne me souvient plus de l'auteur, qu'il veuille m'excuser.
Cordialement

EDIT Bonjour Tototiti
EDIT2 Bonjour Pierrot. Quel tir groupé...

Cliquez pour agrandir...