VBA Liste Dossiers et sous-dossiers d'un dosssier

[MJ13]

Bonjour à tous


Je me permet de vous demander une aide pour avoir la liste des dossiers (ou répertoire) et sous-dossiers d'un Dossier.

J'ai trouvé des tas de codes mais en général on a le nom des fichiers avec.

Le but serait d'avoir le nom des dossiers à trouver en A1 (ex: C:\temp) et que la macro liste l'ensemble des sous-dossiers.

Merci d'avance.

 

[Guest]

Re : VBA Liste Dossiers et sous-dossiers d'un dosssier

Bonjour Michel,

Voici une procédure de Frédéric Sigonneau avec fso:

Sub TousLesDossiers(LeDossier$, Idx As Long)
    Dim fso As Object, Dossier As Object
    Dim sousRep As Object, Flder As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set Dossier = fso.GetFolder(LeDossier)
    'examen du dossier courant
    For Each Flder In Dossier.subfolders
        Idx = Idx + 1
        Cells(Idx, 1).Value = Flder.Path
    Next
    'traitement récursif des sous dossiers
    For Each sousRep In Dossier.subfolders
        TousLesDossiers sousRep.Path, Idx
    Next sousRep
    Set fso = Nothing
End Sub                                               'fs
Sub test()
  TousLesDossiers "D:\LUI\Developement\VB_VBA\", 0
End Sub

A+

 

[MJ13]

Re : VBA Liste Dossiers et sous-dossiers d'un dosssier

Bonjour Hasco

Ah Hasco, mon sauveur🙂.

Merci aussi à Frédéric Sigonneau.

Tu sais qu'il est bien ce code, j'avais lu qu'il fallait de la récurisivité. Et la je vois Récursivité.

En plus c'est du compact. Tout ce que j'aime.

Bon Week-end.

 

[BOISGONTIER]

Re : VBA Liste Dossiers et sous-dossiers d'un dosssier

Bonjour,

Avec visualisation de la hiérarchie.

http://boisgontierjacques.free.fr/fichiers/ArborescenceRepertoireSousRep.xls

JB

 

[MJ13]

Re : VBA Liste Dossiers et sous-dossiers d'un dosssier

Bonjour Jacques

Merci pour le lien.

C'est intéressant.

Et si c'est pas trop demander: Pourrait-on avoir la hiérarchie par colonne?

Bon Week-end

 

[BOISGONTIER]

Re : VBA Liste Dossiers et sous-dossiers d'un dosssier

Voir PJ

JB

 

[MJ13]

Re : VBA Liste Dossiers et sous-dossiers d'un dosssier

Re Jacques

Je ne dirais qu'un mot:

BRAVO

 

[bertrand1202]

Re : VBA Liste Dossiers et sous-dossiers d'un dosssier

Bonjour

Tu peux egalement regarder les macros de MDF soit sur ce site soit sur le site de MDF , il y a une excellente macro qui correspond à ton besoin.

A+

 

[MJ13]

Re : VBA Liste Dossiers et sous-dossiers d'un dosssier

Bonjour Bertrand

Merci pour ton témoignage. Je suis aller voir sur le site de MDF et je n'ai pas bien trouvé. Je sais et j'ai déjà vu le scan des dossiers avec les fichiers, mais je ne voulais avoir que les dossiers et sous-dossiers.

En fait sur le net, on trouve beaucoup de codes pour les fichiers mais peu avec les dossiers et sous-dossiers uniquement.

 

[Roland_M]

Re : VBA Liste Dossiers et sous-dossiers d'un dosssier

bonsoir à tous

si cela peut aussi t'aider
ces classeurs contiennent des routines intéressantes et suffisamment claires
concernant les répertoires/fichiers...

 

[MJ13]

Re : VBA Liste Dossiers et sous-dossiers d'un dosssier

Bonjour Roland

Merci pour ce petit fichier qui a tout d'un grand🙂.

Ah la, on commence a avoir pas mal de routines intéressantes, cela va t'il devenir un incontournable?

Si j'ai le temps de faire un nouveau site sur Excel, je ne manquerai pas de le mettre (mais bon j'avais bien commencé, mais cela prend énormément de temps, peut-être pour noël).

 

[gigiati]

Re : VBA Liste Dossiers et sous-dossiers d'un dosssier

Bonjour à tous,
J'ai pu utiliser ce petit fichiers qui est très utile!

(dommage que je ne comprenne pas tous le code...)

Par contre je me demandais si il y avait un moyen de faire le même principe que "ArborescenceRepertoireSousRep2" mais avec en plus les fichiers? (qui serait dans une autre colonne)

Merci de vos réponses

***EDIT***

Sub Lit_dossier(ByRef dossier, ByVal niveau)
Cells(ligne, niveau) = dossier.Name
ligne = ligne + 1
For Each d In dossier.SubFolders
Lit_dossier d, niveau + 1
Next
For Each f In dossier.Files
nom_fich = f.Name
Lit_dossier f, niveau + 1
Next
End Sub

Ca à l'air de marché jusqu'au premier fichier, ensuite ca bug...

 

[gigiati]

Re : VBA Liste Dossiers et sous-dossiers d'un dosssier

Personne n'aurais une piste?

 

[tototiti2008]

Re : VBA Liste Dossiers et sous-dossiers d'un dosssier

Bonjour,

Une adaptation du code de Jacques :

Les fichiers apparaissent en rouge dans la feuille

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, niveau) = dossier.Name
[COLOR=#ff0000]Cells(ligne, niveau).Font.ColorIndex = 0[/COLOR]
   ligne = ligne + 1
[COLOR=red]  For Each f In dossier.Files[/COLOR]
[COLOR=red]    Cells(ligne, niveau) = f.Name[/COLOR]
[COLOR=red]    Cells(ligne, niveau).Font.ColorIndex = 3[/COLOR]
[COLOR=red]    ligne = ligne + 1[/COLOR]
[COLOR=red]  Next[/COLOR]
   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

 

[kiki29]

Re : VBA Liste Dossiers et sous-dossiers d'un dosssier

Salut,et un de plus ( concocté pour l'ami Paritec il y a qq temps )