Lister un répertoire pour extraire un sommaire

Je me demande si il es possible de scanner un répertoire sélectionné et

de sortir un listing style sommaire qui reprend tout les noms de

répertoire, sous-répertoire et nom des fichiers.

Exemple de répertoire à lister

Répertoire principale
---    Sous-répertoire 1
    ---    Fichier.pdf
    ---    Fichier.doc
---    Sous-répertoire2
    ---Fichier.pdf
    ---    Fichier.doc
----Sous-répertoire3
    ---Fichier.pdf
    ---Fichier.doc
Fichier.pdf

*********************************

Sommaire

Répertoire principale
Sous-répertoire 1
Fichier.pdf
Fichier.doc
Sous-répertoire2
Fichier.pdf
Fichier.doc
Sous-répertoire3
Fichier.pdf
Fichier.doc
Fichier.pdf

Bonne journée

Bonjour,

Voici un essai où la liste devrait s'afficher en colonne 1 de la feuille active :

dim dico as object
Sub Lister()
set dico = createobject("Scripting.dictionary")
with application.filedialog(msofiledialogfolderpicker)
    .show
    if .selecteditems.count = 1 then srep$ = .selecteditems(1) else exit sub
end with
ListeReps srep
cells(1, 1).resize(dico.count).value = application.transpose(dico.keys)
set dico = nothing
end sub

function ListeReps(srep$)
set fso = createobject("Scripting.filesystemobject")
set fd = fso.getfolder(srep)
dico(fd.path) = ""
for each fil in fd.files
    dico(fil.path) = ""
next fil
for each sfd in fd.subfolders
    ListeReps sfd.path
next sfd
end function

Cdlt,

Bonjour 3GB

Merci cela fonctionne super.

Par contre est-il possible de ne pas avoir le chemin devant les noms

Bonne journée

Oui, c'est possible :

dim dico as object
Sub Lister()
set dico = createobject("Scripting.dictionary")
with application.filedialog(msofiledialogfolderpicker)
    .show
    if .selecteditems.count = 1 then srep$ = .selecteditems(1) else exit sub
end with
ListeReps srep
cells(1, 1).resize(dico.count).value = application.transpose(dico.keys)
set dico = nothing
end sub

function ListeReps(srep$)
set fso = createobject("Scripting.filesystemobject")
set fd = fso.getfolder(srep)
dico(fd.name) = ""
for each fil in fd.files
    dico(fil.name) = ""
next fil
for each sfd in fd.subfolders
    ListeReps sfd.path
next sfd
end function

Par contre, la méthode employée permet d'éviter les doublons (il n'y a jamais 2 répertoires identiques) et pourrait poser problème si des dossiers portaient le même nom...

Alors, il y aurait lieu de modifier le code.

Cdlt,

Re bonjour 3GB

Merci pour ton code

Par contre pour les doublons, je risque d'avoir dans les sous sous dossiers des dossiers qui pourrais peut-être porter le même nom ou des fichiers.

Y a t-il une solution si il y a des doublons.

Bonne soirée

Bonjour netparty,

Voici un essai pour conserver les doublons :

public t(), n&

Sub Lister()
with application.filedialog(msofiledialogfolderpicker)
    .show
    if .selecteditems.count = 1 then srep$ = .selecteditems(1) else exit sub
end with
ListeReps srep
cells(1, 1).resize(n).value = application.transpose(t)
erase t: n = 0
end sub

function ListeReps(srep$)
set fso = createobject("Scripting.filesystemobject")
set fd = fso.getfolder(srep)
AjoutItem fd.name
for each fil in fd.files
    AjoutItem fil.name
next fil
for each sfd in fd.subfolders
    ListeReps sfd.path
next sfd
end function

Sub AjoutItem(valeur$)
redim preserve t(n)
t(n) = valeur
n = n + 1
end sub

Cdlt,

Bonjour 3Gb

Merci

A première vue cela fonctionne

Bonne journée