Bonjour, je souhaite lister arborescence de dossier et de sous dossier dans un fichier Excel, j'aimerais que tous les fichiers d'un dossier soient dans la même colonne séparés par une "," jusqu'ici j'ai réussi.

Le problème se pose quand un dossier contient un sous dossier je souhaiterais récupérer le nom de arborescence précédente. Je m'explique voici un exemple de dossier :

[C:\Users\ordi\Documents\Doubsoccase\Travail\fitness\C1] C1 photoImport/C1/A49I0863.JPG, photoImport/C1/A49I0864.JPG, photoImport/C1/A49I0865.JPG, photoImport/C1/A49I0866.JPG
[C:\Users\ordi\Documents\Doubsoccase\Travail\fitness\C1\C11] C11 photoImport/C11/A49I0892.JPG, photoImport/C11/A49I0893.JPG
[C:\Users\ordi\Documents\Doubsoccase\Travail\fitness\C10] C10 photoImport/C10/A49I0888.JPG, photoImport/C10/A49I0889.JPG, photoImport/C10/A49I0890.JPG
[C:\Users\ordi\Documents\Doubsoccase\Travail\fitness\C11] C11 photoImport/C11/A49I0892.JPG, photoImport/C11/A49I0893.JPG, photoImport/C11/A49I0894.JPG


Ce que je souhaiterais c'est pour la ligne 2 le C11 j’obtienne

[C:\Users\ordi\Documents\Doubsoccase\Travail\fitness\C1\C11] C11 photoImport/C1/C11/A49I0892.JPG, photoImport/C1/C11/A49I0893.JPG


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
57
58
59
60
61
62
63
64
65
66
67
68
Dim ligne
Sub arborescence()
  Application.ScreenUpdating = False
  racine = ChoixDossier()          ' ou un répertoire C:\xxx e.g.
  If racine = "" Then Exit Sub
  Range("A3:E20000").ClearContents
  Range("A3").Select
  Set fs = CreateObject("Scripting.FileSystemObject")
  Set dossier_racine = fs.GetFolder(racine)
  ligne = 3
 
    liens = ""
 
   virgule = 0
  Lit_dossier dossier_racine, 1
End Sub
Sub Lit_dossier(ByRef dossier, ByVal niveau)
   Cells(ligne, 1) = "[" & dossier.Path & "]"
 
 
   For Each f In dossier.Files
 
 
 
  If virgule >= 1 Then
  liens = liens & ", " & "photoImport/" & dossier.Name & "/" & f.Name
  Else
 
      liens = liens & "photoImport/" & dossier.Name & "/" & f.Name
   End If
 
  virgule = virgule + 1
 
 
 
   Next
 
 
 
    Cells(ligne, 2) = dossier.Name
 
 
   Cells(ligne, 3) = liens
 
 
    ligne = ligne + 1
   For Each d In dossier.SubFolders
 
     Lit_dossier d, niveau + 1
 
   Next
   MsgBox " 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


pouvez vous m'aider a modifié mon code, la je suis un peu bloqué merci