VBA Liste Dossiers et sous-dossiers d'un dosssier

MJ13

XLDnaute Barbatruc
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.
 
G

Guest

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

Bonjour Michel,

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

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

XLDnaute Barbatruc
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.
 

MJ13

XLDnaute Barbatruc
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
 
Dernière édition:

MJ13

XLDnaute Barbatruc
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.
 
Dernière édition:

Roland_M

XLDnaute Barbatruc
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...
 

Pièces jointes

  • ListRepFichArborescence2.xlsm
    78.3 KB · Affichages: 1 811
Dernière édition:

MJ13

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

XLDnaute Nouveau
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...
 
Dernière édition:

tototiti2008

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

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

XLDnaute Barbatruc
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 )
 

Pièces jointes

  • Liste.zip
    37.1 KB · Affichages: 2 673
  • Liste.zip
    37.1 KB · Affichages: 2 525
  • Liste.zip
    37.1 KB · Affichages: 2 827
Dernière édition:

Discussions similaires

Réponses
9
Affichages
259

Statistiques des forums

Discussions
311 723
Messages
2 081 932
Membres
101 844
dernier inscrit
pktla