[Toutes versions] Arborescence répertoire vers Excel

[kiko_gre]

Bonjour

Grâce à la fenêtre DOS, j'ai exporté dans un fichier CSV, la liste de tous mes répertoires et sous-répertoires.
J'aimerais afficher dans un fichier Excel ce listing, mais en mettant dans des colonnes séparées les sous-répertoires.

Par ex:
- le répertoire A dans la colonne 1
- le répertoire A.1 dans la colonne 2
- le répertoire A.1.1 dans la colonne 3
...

Cela est-il possible?

Merci.

[aereno]

Bonjour,

J'ai créé mon fichier csv avec la commande :

Code :

tree > c:\temp\test.csv

quand j'ouvre ce fichier avec Excel, il contient des caractères comme :
³
ÃÄÄÄ

J'ai sélectionné la colonne A, clic sur onglet Données, convertir

clic sur "délimité", suivant

Comme séparateurs, autre : ³ (récupéré en copier coller)

suivant puis terminer.

Le découpage sur les colonnes correspond à ce que tu attend. il ne reste plus qu'à supprimer les parasites (tels que ÃÄÄÄ) et recréer les caractères accentués avec la fonction remplacer.

[kiko_gre]

Ok merci, ça marche bien.

J'ai juste une question pour comprendre comment cela fonctionne: comment Excel sait-il qu'il doit passer de la colonne 2 à la 3; de la 3 à la 4...?

Le séparateur "³ " pourrait tout déplacer dans la colonne2; mais pas dans les autres...

[aereno]

Il y a un "³" par niveau de profondeur dans l'arborescence.

quand il y a un un "³", par exemple la fonction "convertir" identifie une cellule vide à gauche du "³" et une deuxième à droite : celle qui contient notre nom de répertoire.

[Michel_M]

Bonour,

Pourquoi passer par un fichier csv?
excel pourrait peut-être le faire directement...

[Michel_M]

Re,

ci dessous code retrouvé sur le site de Frédéric Sigonneau (pas trouvé d'équivalent dans la FAQ Excel DVP mais peut-^tre mal cherché)

liste des répertoires et sous répertoires d'un lecteur

Code :

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
79
80
Sub DriveContents()
'Tom Ogilvy, mpep
Dim rw As Long
Dim ilevel As Long
Dim sPath As String
Dim Drive As String
Dim AnyName As String
Dim Volume As String
Dim i As Integer
 
  Drive = InputBox("Entrer la lettre d'un lecteur" & vbCrLf & "(ie. D or d) ")
  If Trim(Drive) = "" Then Exit Sub
  Drive = StrConv(Drive, vbUpperCase)
  Drive = Drive & ":\"
  Sheets.Add
Dim sArr() As String
  ReDim sArr(1 To 1)
  rw = 1
  ilevel = 1
  Cells(rw, ilevel) = Dir(Drive, vbVolume)
  rw = rw + 1
  Cells(rw, ilevel) = Drive '"\"
  rw = rw + 1
  AnyName = Dir(Drive, vbDirectory)
  Do While AnyName <> ""
    If AnyName <> "." And AnyName <> ".." _
                And GetAttr(Drive & AnyName) = vbDirectory Then
      sArr(UBound(sArr)) = AnyName
      ReDim Preserve sArr(1 To UBound(sArr) + 1)
    End If
    AnyName = Dir()
  Loop
  ilevel = ilevel + 1
  For i = 1 To UBound(sArr) - 1
    AnyName = sArr(i)
    Cells(rw, ilevel) = AnyName
    rw = rw + 1
    sPath = Drive & AnyName & "\"
    GetSubs sPath, rw, ilevel
  Next
 
  AnyName = Dir(Drive, vbNormal)
  Do While AnyName <> ""
    Cells(rw, ilevel) = AnyName
    rw = rw + 1
    AnyName = Dir()
  Loop
End Sub
 
 
Sub GetSubs(sPath As String, rw As Long, ilevel As Long)
Dim sName As String
Dim i As Long
Dim sArr()
 
  ReDim sArr(1 To 1)
  sName = Dir(sPath, vbDirectory)
  Do While sName <> ""
    If sName <> "." And sName <> ".." And _
            GetAttr(sPath & sName) = vbDirectory Then
      sArr(UBound(sArr)) = sName
      ReDim Preserve sArr(1 To UBound(sArr) + 1)
    End If
    sName = Dir()
  Loop
  For i = 1 To UBound(sArr) - 1
    sName = sArr(i)
    Cells(rw, ilevel + 1) = sName
    rw = rw + 1
    GetSubs sPath & sName & "\", rw, ilevel + 1
  Next i
 
  'option avec liste des fichiers du sous répertoire
  'sName = Dir(sPath, vbNormal)
  'Do While sName <> ""
    'Cells(rw, ilevel + 1) = sName
    'rw = rw + 1
    'sName = Dir()
  'Loop
End Sub

[kiko_gre]

Bonjour

N'y connaissant pas grand chose aux macros, voilà comment j'ai fait:
- création d'1 macro: macro_2607
- j'ai copié-collé votre code dedans

mais il me dit qu'il y a une erreur END SUB => je ne comprends pas.
Faut-il changer des paramètres?

voilà ma macro:

Code :

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
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
 
Sub Macro_2607()
'
' Macro_2607 Macro
'
 
Sub DriveContents()
'Tom Ogilvy, mpep
Dim rw As Long
Dim ilevel As Long
Dim sPath As String
Dim Drive As String
Dim AnyName As String
Dim Volume As String
Dim i As Integer
 
  Drive = InputBox("Entrer la lettre d'un lecteur" & vbCrLf & "(ie. D or d) ")
  If Trim(Drive) = "" Then Exit Sub
  Drive = StrConv(Drive, vbUpperCase)
  Drive = Drive & ":\"
  Sheets.Add
Dim sArr() As String
  ReDim sArr(1 To 1)
  rw = 1
  ilevel = 1
  Cells(rw, ilevel) = Dir(Drive, vbVolume)
  rw = rw + 1
  Cells(rw, ilevel) = Drive '"\"
  rw = rw + 1
  AnyName = Dir(Drive, vbDirectory)
  Do While AnyName <> ""
    If AnyName <> "." And AnyName <> ".." _
                And GetAttr(Drive & AnyName) = vbDirectory Then
      sArr(UBound(sArr)) = AnyName
      ReDim Preserve sArr(1 To UBound(sArr) + 1)
    End If
    AnyName = Dir()
  Loop
  ilevel = ilevel + 1
  For i = 1 To UBound(sArr) - 1
    AnyName = sArr(i)
    Cells(rw, ilevel) = AnyName
    rw = rw + 1
    sPath = Drive & AnyName & "\"
    GetSubs sPath, rw, ilevel
  Next
 
  AnyName = Dir(Drive, vbNormal)
  Do While AnyName <> ""
    Cells(rw, ilevel) = AnyName
    rw = rw + 1
    AnyName = Dir()
  Loop
End Sub
 
 
Sub GetSubs(sPath As String, rw As Long, ilevel As Long)
Dim sName As String
Dim i As Long
Dim sArr()
 
  ReDim sArr(1 To 1)
  sName = Dir(sPath, vbDirectory)
  Do While sName <> ""
    If sName <> "." And sName <> ".." And _
            GetAttr(sPath & sName) = vbDirectory Then
      sArr(UBound(sArr)) = sName
      ReDim Preserve sArr(1 To UBound(sArr) + 1)
    End If
    sName = Dir()
  Loop
  For i = 1 To UBound(sArr) - 1
    sName = sArr(i)
    Cells(rw, ilevel + 1) = sName
    rw = rw + 1
    GetSubs sPath & sName & "\", rw, ilevel + 1
  Next i
 
  'option avec liste des fichiers du sous répertoire
  'sName = Dir(sPath, vbNormal)
  'Do While sName <> ""
    'Cells(rw, ilevel + 1) = sName
    'rw = rw + 1
    'sName = Dir()
  'Loop
End Sub
'
    Application.Goto Reference:="Macro_2607"
    ActiveWorkbook.SaveAs Filename:= _
        "C:\Documents and Settings\administrateur\Mes documents\macro.xltm", _
        FileFormat:=xlOpenXMLTemplateMacroEnabled, Password:="", WriteResPassword _
        :="", ReadOnlyRecommended:=False, CreateBackup:=False
    ActiveWorkbook.Save
    ActiveWorkbook.Save
End Sub

[kiki29]

Salut,un exemple perfectible et à adapter à ton contexte

[Michel_M]

Bonjour
enlève le sub drivecontents()
enlève le end sub ligne 86

mais je n'ai pas compris cette ligne
applicatuion;goto reference....

Regarde la proposition de kiki qui a l'air intéressante