Discussion :

[GoFio]

Bonjour,

Le code que j'ai actuellement me permet de récupérer les noms des derniers sous dossiers d'une arborescence d'un répertoire. J'aimerais pouvoir récupérer également le nom du dossier contenant ces sous dossiers.

Exemple :
Dossier 1 >
_________SDossier 1a >
_____________________Sdossier1b >
_________________________________SDossier1c
_________________________________SDossier2c
_________________________________SDossier3c
_________________________________ SDossier4c

_________SDossier 2a >
_____________________Sdossier1b >
_________________________________SDossier1c
_________________________________SDossier2c
_________________________________SDossier3c
_________________________________SDossier4c

Pour le moment mon code me permet d'avoir dans un tableau tout les noms de dossiers de catégorie c
J'aimerais également pouvoir obtenir ceux de catégorie b


Voici le code que j'ai à présent :
(les tableaux sont déclarés en public)

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
Sub arborescenceRepertoire()
 
    Dim i As Integer, j As Integer, ligne As Integer
    Dim fs As Object
    Dim dossier_racine As Object
 
    For i = 1 To 100
        For j = 1 To 100
        Tableau_NomCas(j, i) = ""
        Tableau_Adresses(j, i) = ""
        'Tableau_Dossier(j, i) = ""
        Next j
    Next i
 
  racine = ChoixDossier() 
 
  If racine = "" Then Exit Sub
 
  UserForm1.TextBox2.Value = racine
 
 
  Set fs = CreateObject("Scripting.FileSystemObject")
  Set dossier_racine = fs.getfolder(racine)
 
  Lit_dossier dossier_racine, 1, 0, 0
 
  Call Arborescence_Final
 
End Sub

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
 
Sub Lit_dossier(dossier As Object, niveau As Integer, ligne As Integer, colonne As Integer)
 
    Dim d As Object
 
    Tableau_Adresses(ligne + 1, colonne + 1) = dossier.Path
    Tableau_NomCas(ligne + 1, colonne + 1) = dossier.Name
    'Tableau_Dossier(ligne + 1, colonne + 1) = Tableau_NomCas(ligne + 1, colonne + 1)
 
    For Each d In dossier.SubFolders
 
'        If ligne = 0 Then
'                Tableau_Dossier(ligne + 1, colonne + 1) = Tableau_NomCas(ligne + 1, colonne + 1)
'        End If
        colonne = colonne + 1
        Lit_dossier d, niveau, ligne, colonne
        ligne = ligne + 1
        colonne = colonne - 1
    Next
 
End Sub

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
69
70
71
72
73
74
75
76
77
78
Sub Arborescence_Final()
 
Dim i As Integer, j As Integer, nbniveau As Integer, nbresultat As Integer
 
    nbniveau = 0
    nbresultat = 0
    j = 0
 
    For i = 1 To 100
        If Tableau_NomCas(1, i) <> "" Then
            nbniveau = nbniveau + 1
        End If
    Next
 
    For i = 1 To 100
        If Tableau_Adresses(i, nbniveau) <> "" Then
            nbresultat = nbresultat + 1
        End If
    Next
 
    For i = 1 To 100
        If Tableau_Dossier(1, i) <> "" Then
            nbniveau = nbniveau + 1
        End If
    Next
 
    For i = 1 To 100
            If Tableau_NomCas(i, nbniveau) = "" Then
                While i + j < 100 And Tableau_NomCas(i + j, nbniveau) = ""
                    j = j + 1
                Wend
                If i + j <= 100 Then
                    Tableau_NomCas(i, nbniveau) = Tableau_NomCas(i + j, nbniveau)
                    Tableau_NomCas(i + j, nbniveau) = ""
                    j = 0
                End If
            End If
 
    '        If Tableau_Dossier(i, nbniveau) = "" Then
    '            While i + j < 100 And Tableau_Dossier(i + j, nbniveau) = ""
    '                j = j + 1
    '            Wend
    '            If i + j <= 100 Then
    '               Tableau_Dossier(i, nbniveau) = Tableau_Dossier(i + j, nbniveau)
    '                Tableau_Dossier(i + j, nbniveau) = ""
    '               j = 0
    '            End If
    '       End If
 
 
            If Tableau_Adresses(i, nbniveau) = "" Then
                While i + j < 100 And Tableau_Adresses(i + j, nbniveau) = ""
                    j = j + 1
                Wend
                    If i + j <= 100 Then
                        Tableau_Adresses(i, nbniveau) = Tableau_Adresses(i + j, nbniveau)
                        Tableau_Adresses(i + j, nbniveau) = ""
                        j = 0
                    End If
            End If
    Next i
 
    ReDim Tableau_Arborescence_Final(1 To nbresultat, 0 To 3)
 
    For i = 1 To nbresultat
            Tableau_Arborescence_Final(i, 3) = Tableau_Adresses(i, nbniveau) + "\data-gen."
                Worksheets("Feuil1").Cells(i, 4).Value = Tableau_Adresses(i, nbniveau) + "\data-gen."
            Tableau_Arborescence_Final(i, 2) = Tableau_Adresses(i, nbniveau) + "\resultats."
                Worksheets("Feuil1").Cells(i, 3).Value = Tableau_Adresses(i, nbniveau) + "\resultats."
            Tableau_Arborescence_Final(i, 1) = Tableau_NomCas(i, nbniveau)
                Worksheets("Feuil1").Cells(i, 2).Value = Tableau_NomCas(i, nbniveau)
            'Tableau_Arborescence_Final(i, 0) = Tableau_Dossier(i, nbniveau)
                'Worksheets("Feuil1").Cells(i, 1).Value = Tableau_Dossier(i, nbniveau)
    Next i
 
    j = 0
 
End Sub

J'étais partis sur la création d'un autre Tableau (Tableau_Dossier) qui m'aurait renvoyer le nom du Tableau_Cas à (n-1). Mais à cause de la récursivité de Lit_Dossier, ça ne fonctionne pas.

La personne qui a codé avant moi avec du s'inspirer de ce code car je suis retombé dessus en faisant des recherche sur le sujet.

Il est bien pratique car j'obtiens toute l'arborescence, seulement après je ne sais pas dans quel colonne se trouve les noms de dossier du (n-1) si je doit aller les chercher de manière automatique par la suite.

Si vous avez une piste qui pourrait m'aider, ça me serait fortement utile. Merci

Cordialement

[boisgontierjacques]

Bonjour,

Exemple en PJ

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
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

Jacques Boisgontier

[Qwazerty]

Salut

Tu as aussi cette solution.

++
Qwaz

[GoFio]

Merci à vous !

boisgontierjacques j'avais déjà trouvé ton fichier en faisant des recherches.
Le problème est que si je lance un calcul et que je lui dit sur la première ligne écrit moi les noms des dossiers (n-1), c'est assez compliqué à récupérer.

Qwazerty, j'ai pas réussis à faire fonctionner ta macro . J'ai pourtant changé l'adresse dans tabretour et Activé Microsoft Scripting Runtine

En repartant de la macro que j'ai mis en fichier joint, j'ai modifié des trucs et ça donne ç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
Option Explicit
Dim racine, fs, dossier_racine, d
Dim ligne As Integer, niveau As Integer, niveaumax As Integer
 
 
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 = 1
  Lit_dossier dossier_racine, 1
 
  Call SuppressionCellulesVide(ligne, niveaumax)
 
End Sub
Sub Lit_dossier(ByRef dossier, ByVal niveau)
 
   Cells(ligne, niveau) = dossier.Name
   For Each d In dossier.SubFolders
     Lit_dossier d, niveau + 1
     ligne = ligne + 1
   Next
 
   If ligne = 1 Then
      niveaumax = niveau
   End If
 
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
 
Sub SuppressionCellulesVide(ligne, niveaumax)
 
Range(Cells(1, 2), Cells(ligne, niveaumax)).Select
Selection.SpecialCells(xlCellTypeBlanks).Select
Selection.Delete Shift:=xlUp
 
End Sub

Je mais le fichier en PJ :

C'est plus ce que je cherchais.
Mais j'aimerais avoir le même résultat sans écrire dans la feuille, mais en mémoire.
Que chaque colonne représente un tableau qui contient les noms de son niveau de dossier.
Car apparemment c'est plus rapide de manipuler les données en mémoire.

Il faudrait que je remplace :

Code :

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

Cells(ligne, niveau) = dossier.Name

Par un tableau qui soit nouveau à chaque niveau, mais à cause de la récursivité, ça m'a l'air bien compliqué.

Cordialement

[Marc-L]

Bonjour,

même en récupérant l'intégralité des dossiers, un Split sur le chemin complet d'un dossier indique donc son niveau
et comme chaque niveau d'un tableau principal peut contenir un tableau … Voir l'instruction ReDim Preserve …

Utiliser les variables tableaux en VBA Excel

Conceptualisation des variables tableau en VBA

[GoFio]

Merci !
Parce que j'étais en train de me prendre la tête à essayer de déclarer des tableaux dans une boucle for ^^

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
Sub RemplirTableauArbo(ligne As Integer, niveaumax As Integer)
    Dim i As Integer, j As Integer
    Dim DosPrinc As String
 
    DosPrinc = Cells(1, 1)
 
    ReDim  TableauArbo(1 To niveaumax - 1, 1 To ligne)
 
    For j = niveaumax - 1 To 1 Step -1
        For i = 1 To ligne
            If Cells(i, j + 1) <> "" Then
                TableauArbo(j, i) = Cells(i, j + 1)
            Else
                ReDim Preserve TableauArbo(1 To niveaumax - 1, 1 To i)
                i = ligne
            End If
        Next
    Next
 
 
End Sub

Par contre si je veux réutiliser les données du tableau ensuite je n'ai pas l'impression de pouvoir récupérer les données de j=4 par exemple

et comme chaque niveau d'un tableau principal peut contenir un tableau

En faite le tableau dans le tableau sera des mêmes dimensions avec la dernières variables plus grandes ou non?

Si je prends l'exemple de l'aide d'excel :

ReDim X(10, 10, 10)
. . .
ReDim Preserve X(10, 10, 15)

Est ce que ça signifie qu'il garde les données 1 à 10 et qu'il va remplir seulement les données de 11 à 15?

Cordialement,

EDIT :

En modifiant le code juste au dessus, j'obtiens bien la réponse à mon problème à savoir : Conserver le nom de dossier (n-1)

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
Sub RemplirTableauArbo(ligne As Integer, niveaumax As Integer)
    Dim i As Integer, j As Integer
    Dim DosPrinc As String
 
    DosPrinc = Cells(1, 1)
 
    ReDim Preserve TableauArbo(1 To ligne)
 
        For i = 1 To ligne
            If Cells(i, niveaumax - 1) <> "" Then
                TableauArbo(i) = Cells(i, niveaumax - 1)
            Else
                ReDim TableauArbo(1 To i)
                i = ligne
            End If
        Next
 
End Sub

Donc je passe le sujet en résolu. Mais comme je n'ai pas tout compris le coup de Preserve Tableau, je veux bien vos avis.
Car dans l'idéal j'aimerais avoir le tableau créé au dessus mais pour chaque niveau allant du niveau 2 au niveau max et pas seulement le (n-1)


Merci boisgontierjacques, Qwazerty et Marc-L !

[Marc-L]

L'instruction Redim Preserve sert juste à modifier la dernière dimension d'une variable tableau sans perdre les données
déjà présentes et, dans le cas d'un agrandissement, les nouveaux indices sont vierges ou à zéro selon le type de variable …

Création des niveaux dans la variable tableau NV depuis la liste des dossiers de la variable tableau DL :

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
Sub DemoImbricationTableaux()
    Const SRC$ = "D:\Dossier\Source"
 
    DL = Split("D:\Dossier\Source\Niveau1A D:\Dossier\Source\Niveau1B " & _
               "D:\Dossier\Source\Niveau1A\Niveau2A D:\Dossier\Source\Niveau1A\Niveau2B " & _
               "D:\Dossier\Source\Niveau1B\Niveau2C D:\Dossier\Source\Niveau1B\Niveau2D " & _
               "D:\Dossier\Source\Niveau1A\Niveau2A\Niveau3A " & _
               "D:\Dossier\Source\Niveau1A\Niveau2A\Niveau3B " & _
               "D:\Dossier\Source\Niveau1A\Niveau2A\Niveau3C " & _
               "D:\Dossier\Source\Niveau1B\Niveau2C\Niveau3D " & _
               "D:\Dossier\Source\Niveau1B\Niveau2C\Niveau3E " & _
               "D:\Dossier\Source\Niveau1B\Niveau2C\Niveau3F")
 
    ReDim NV(1 To 1)
 
    For Each V In DL
        SP = Split(Replace(V, SRC, ""), "\")
        U& = UBound(SP)
        If U > UBound(NV) Then ReDim Preserve NV(1 To U)
        If VarType(NV(U)) Then NV(U) = Split(Join(NV(U)) & " " & SP(U)) Else NV(U) = Array(SP(U))
    Next
 
    [A1].CurrentRegion.Clear
 
    For U = 1 To UBound(NV)
        Debug.Print "Niveau"; U; ":"; UBound(NV(U)) + 1; "dossiers", U & "-1 = "; NV(U)(0)
        Cells(U).Resize(UBound(NV(U)) + 1).Value = Application.Transpose(NV(U))
    Next
 
    End
End Sub

Placer un point d'arrêt avant la fin du code ou suivre sa progression en mode pas à pas (touche F8)
afin de consulter dans la fenêtre Variables locales la structure de la variable tableau NV …

Une fois acquise la méthode à posteriori, son adaptation n'est pas compliquée lors de la recherche des dossiers,
une variable tableau définie au niveau du module au lieu de la procédure devrait suffire …

[Qwazerty]

Salut

Qwazerty, j'ai pas réussis à faire fonctionner ta macro . J'ai pourtant changé l'adresse dans tabretour et Activé Microsoft Scripting Runtine

Désolé, c'est une erreur de ma part, la contribution que j'avais faite a pour but de lister les fichiers, pas les répertoires, désolé .

[Edit]
Pour la peine, voila une modification du fichier pour pouvoir lister les répertoires et sous répertoire en plus des fichiers
[/Edit]

Bonne continuation
++
Qwaz