Liste des répertoires et fichiers

**julien_julio** · 28/12/2018, 14h29

Bonjour,

J'ai vu de nombreuses questions sur le sujet mais je n'ai pas trouvé de réponses concluantes.
Je cherche à établir un tableau excel qui ferait apparaître l'aborescence d'un dossier et la liste des fichiers de chaque dossier.
Par exemple:
- COLONNE A: dossier 1 => fichier 1a, fichier 1b..., dossier 11
- COLONNE B: dossier 11 => fichier 11a, fichier 11b, dossier 111
- COLONNE C: dossier 111 =>....
...

Comme ça on obtient le rang en terme de dossier et le contenu de chaque dossier et sous dossier.

Sauriez-vous comment faire? Je n'y connais malheureusement pas grand chose en macro... ;(

Merci à vous.
Julien

**BoorBox** · 28/12/2018, 14h54

Essaie ça :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
 
 
Dim ligne
 
Sub arborescence(file_tbl() As String)
  Application.ScreenUpdating = False
  racine = ChoixDossier()          ' ou un répertoire C:\xxx e.g.
  If racine = "" Then Exit Sub
  Set fs = CreateObject("Scripting.FileSystemObject")
  Set dossier_racine = fs.GetFolder(racine)
  ligne = 3
  Lit_dossier dossier_racine, 1, file_tbl
End Sub
 
 
Sub Lit_dossier(ByRef dossier, ByVal niveau, ByRef file_tbl() As String)
   Dim file_nbr As Integer
   file_nbr = 0
   Cells(ligne, 1) = String(4 * (niveau - 1), " ") & "[" & dossier.Path & "]"
   ligne = ligne + 1
   For Each f In dossier.Files
     file_name = f.name
     For i = 1 To Len(file_name)
        If (Right(file_name, i) = ".xls") Or (Right(file_name, i) = ".xlsx") Then
            file_nbr = file_nbr + 1
            ReDim Preserve file_tbl(file_nbr)
            file_tbl(file_nbr - 1) = dossier.Path & "\" & f.name
            Cells(ligne, 1) = file_tbl(file_nbr - 1)
            ligne = ligne + 1
        End If
 
     Next
     If f.Attributes And vbHidden Then Cells(ligne, 5) = "Caché"
 
   Next
   For Each d In dossier.SubFolders
     Lit_dossier d, niveau + 1, file_tbl
   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

Il y auras sans doute des erreurs dues à des variables non définies