Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11

Récupérer noms répertoires/sous-rép. et fichiers

21 réponses
Avatar
gauso
Bonjour,
Je cherche =E0 pouvoir r=E9cup=E9rer, dans un champ texte (Memo), les noms
des r=E9pertoires, sous-r=E9pertoires, ainsi que les noms (y compris
extensions) des fichiers contenus dans ceux-ci...
Apr=E8s parcours du forum et de l'aide Access (2003), je ne trouve rien
qui r=E9ponde =E0 ma question...
Des pistes, des bouts de codes, que je suis bien incapable
d'adapter...
J'ai =E9cris le code suivant qui fonctionne mais ne me ram=E8ne que le
premier niveau (ne va pas chercher dans les sous-r=E9pertoires !)

Dim sPath, fso, Directory, SubFolders, Folders, File, Files
Dim sTmp As String
sPath =3D "NomDeMonRepertoireAExplorer"

Set fso =3D CreateObject("Scripting.FileSystemObject")
Set Directory =3D fso.GetFolder(sPath)
Set SubFolders =3D Directory.SubFolders
For Each Folders In SubFolders
sTmp =3D sTmp & Folders.name & ";"

Set Files =3D Directory.Files
For Each File In Files
Debug.Print File.name
sTmp =3D sTmp & File.name & ";"
Next File

Next Folders
sTmp =3D Left(sTmp, Len(sTmp) - 1)
MsgBox sTmp
Me![Description] =3D Me![Description] & vbCrLf & sTmp
Set SubFolders =3D Nothing
Set fso =3D Nothing
Set Directory =3D Nothing
Set File =3D Nothing
Set Files =3D Nothing

Merci par avance =E0 ceux qui voudront bien m'aider,
Sonia.

10 réponses

1 2 3
Avatar
Gilbert
Bonjour

Voici une procédure pour lister les répertoires et sous-répertoires.
Tu n'as qu'à y ajouter les fichiers

Sub test()
Call ListerSousRepertoires(LeNomDeTonDossier)
End Sub

Sub ListerSousRepertoires(sPath As String)
Dim fso As Object
Dim Directory As Object
Dim SubFolders As Object
Dim Folders As Object

Set fso = CreateObject("Scripting.FileSystemObject")
Set Directory = fso.GetFolder(sPath)
Set SubFolders = Directory.SubFolders

For Each Folders In SubFolders
Debug.Print strtmp & Folders.Name
Call ListerSousRepertoires(Folders.Path)
Next Folders

Set Folders = Nothing
Set SubFolders = Nothing
Set fso = Nothing
Set Directory = Nothing
End Sub


--
Cordialement,

Gilbert


"gauso" a écrit dans le message de
news:
Bonjour,
Je cherche à pouvoir récupérer, dans un champ texte (Memo), les noms
des répertoires, sous-répertoires, ainsi que les noms (y compris
extensions) des fichiers contenus dans ceux-ci...
Après parcours du forum et de l'aide Access (2003), je ne trouve rien
qui réponde à ma question...
Des pistes, des bouts de codes, que je suis bien incapable
d'adapter...
J'ai écris le code suivant qui fonctionne mais ne me ramène que le
premier niveau (ne va pas chercher dans les sous-répertoires !)

Dim sPath, fso, Directory, SubFolders, Folders, File, Files
Dim sTmp As String
sPath = "NomDeMonRepertoireAExplorer"

Set fso = CreateObject("Scripting.FileSystemObject")
Set Directory = fso.GetFolder(sPath)
Set SubFolders = Directory.SubFolders
For Each Folders In SubFolders
sTmp = sTmp & Folders.name & ";"

Set Files = Directory.Files
For Each File In Files
Debug.Print File.name
sTmp = sTmp & File.name & ";"
Next File

Next Folders
sTmp = Left(sTmp, Len(sTmp) - 1)
MsgBox sTmp
Me![Description] = Me![Description] & vbCrLf & sTmp
Set SubFolders = Nothing
Set fso = Nothing
Set Directory = Nothing
Set File = Nothing
Set Files = Nothing

Merci par avance à ceux qui voudront bien m'aider,
Sonia.
Avatar
gogo
Bon, j'ai déjà posté une réponse hier directement sur le site et celle-ci
n'apparaît toujours pas !!?
Donc, je réitère en espérant que cette fois le système voudra bien
enregistrer...

Je voulais donc remerçier Gilbert car finalement j'ai bidouillé quelque
chose qui semble bien fonctionner... voilà ce que cela donne (vos critiques
sont les bienvenues sur la forme) :

Sub test()
Call ListerSousRepertoires(LeNomDeTonDossier)
End Sub

Sub ListerSousRepertoires(spath As String)
Dim fso As Object
Dim Directory As Object
Dim SubFolders As Object
Dim Folders As Object
Dim sTmp As String

Set fso = CreateObject("Scripting.FileSystemObject")
Set Directory = fso.GetFolder(spath)
Set SubFolders = Directory.SubFolders

For Each Folders In SubFolders
Debug.Print strtmp & Folders.name
Call ListerSousRepertoires(Folders.Path)
Call ListerFichiers(Folders.Path)
Next Folders

Set Folders = Nothing
Set SubFolders = Nothing
Set fso = Nothing
Set Directory = Nothing
End Sub

Sub ListerFichiers(spath As String)
Dim fso As Object
Dim Repertoire As Object
Dim SubFolder As Object
Dim File, Files As Object

Set fso = CreateObject("Scripting.FileSystemObject")
Set Repertoire = fso.GetFolder(spath)
Set Files = Repertoire.Files

For Each File In Files
Debug.Print strtmp & File.name
Next File

Set Files = Nothing
Set File = Nothing
Set SubFolders = Nothing
Set fso = Nothing
Set Repertoire = Nothing
End Sub

Quand j'exécute cela, j'ai bien tous mes répertoires/sous-répertoires et
fichiers dans la fenêtre d'exécution : seulement voilà, maintenant je ne
sais comment récupérer le contenu de cette fenêtre pour l'intégrer dans le
champ de mon formulaire ? Ou bien une autre méthode pour récupérer
l'information ainsi rassemblée ?
Un truc que je ne pige pas (entre autre) c'est ce "strtmp", déclaré nul part
et qui pourtant passe sans problème ?
Bref merci de m'aider encore un peu : je bloque !
Cordialement,
Sonia.
Avatar
Michel_D
Bonjour,

Bon, j'ai déjà posté une réponse hier directement sur le site et celle-ci
n'apparaît toujours pas !!?
Donc, je réitère en espérant que cette fois le système voudra bien
enregistrer...

Je voulais donc remerçier Gilbert car finalement j'ai bidouillé quelque
chose qui semble bien fonctionner... voilà ce que cela donne (vos critiques
sont les bienvenues sur la forme) :

Sub test()
Call ListerSousRepertoires(LeNomDeTonDossier)
End Sub

Sub ListerSousRepertoires(spath As String)
Dim fso As Object
Dim Directory As Object
Dim SubFolders As Object
Dim Folders As Object
Dim sTmp As String

Set fso = CreateObject("Scripting.FileSystemObject")
Set Directory = fso.GetFolder(spath)
Set SubFolders = Directory.SubFolders

For Each Folders In SubFolders
Debug.Print strtmp & Folders.name
Call ListerSousRepertoires(Folders.Path)
Call ListerFichiers(Folders.Path)
Next Folders

Set Folders = Nothing
Set SubFolders = Nothing
Set fso = Nothing
Set Directory = Nothing
End Sub

Sub ListerFichiers(spath As String)
Dim fso As Object
Dim Repertoire As Object
Dim SubFolder As Object
Dim File, Files As Object

Set fso = CreateObject("Scripting.FileSystemObject")
Set Repertoire = fso.GetFolder(spath)
Set Files = Repertoire.Files

For Each File In Files
Debug.Print strtmp & File.name
Next File

Set Files = Nothing
Set File = Nothing
Set SubFolders = Nothing
Set fso = Nothing
Set Repertoire = Nothing
End Sub

Quand j'exécute cela, j'ai bien tous mes répertoires/sous-répertoires et
fichiers dans la fenêtre d'exécution : seulement voilà, maintenant je ne
sais comment récupérer le contenu de cette fenêtre pour l'intégrer dans le
champ de mon formulaire ? Ou bien une autre méthode pour récupérer
l'information ainsi rassemblée ?
Un truc que je ne pige pas (entre autre) c'est ce "strtmp", déclaré nul part
et qui pourtant passe sans problème ?
Bref merci de m'aider encore un peu : je bloque !
Cordialement,
Sonia.



Ce "strtmp" est une variable non définis donc à la base de type "variant" en
gros le type va s'adapter lors de la 1ére affectation et comme il n'y a pas
d'affectation cette variable ne sert à rien, par contre cette variable ou
plutot "sTmp" pourrait te servir à récupérer par concaténation le résultat,
pour cela il faudrait bien sur transformer la procédure en fonction.

PS: Il doit être possible de regrouper les 2 procédures
ListerSousRepertoires
ListerFichiers

Avatar
gogo
Merci pour ces éclaircissements...
De mon côté j'avance, mais pas encore obtenu tout à fait ce que je
souhaitais (je ne sais pas si c'est possible...?)
Voilà ce que finalement j'ai écris pour récupérer les données dans mon champ
:

Sub test()
Call ListerSousRepertoires(LeNomDeTonDossier)
End Sub

Sub ListerSousRepertoires(spath As String)
Dim fso As Object
Dim Directory As Object
Dim SubFolders As Object
Dim Folders As Object
Dim strtmp

Set fso = CreateObject("Scripting.FileSystemObject")
Set Directory = fso.GetFolder(spath)
Set SubFolders = Directory.SubFolders

For Each Folders In SubFolders
Debug.Print strtmp & Folders.name
strtmp = strtmp & Folders.name & ";"
Call ListerSousRepertoires(Folders.Path)
Call ListerFichiers(Folders.Path)

Next Folders
Me![Description] = Me![Description] & vbCrLf & strtmp

Set Folders = Nothing
Set SubFolders = Nothing
Set fso = Nothing
Set Directory = Nothing
End Sub

Sub ListerFichiers(spath As String)

Dim fso As Object
Dim Repertoire As Object
Dim SubFolder As Object
Dim File, Files As Object
Dim strtmp
Dim recupfichiers As String

Set fso = CreateObject("Scripting.FileSystemObject")
Set Repertoire = fso.GetFolder(spath)
Set Files = Repertoire.Files

For Each File In Files
Debug.Print strtmp & File.name
strtmp = strtmp & File.name & ";"

Next File
Me![Description] = Me![Description] & vbCrLf & strtmp

Set Files = Nothing
Set File = Nothing
Set SubFolder = Nothing
Set fso = Nothing
Set Repertoire = Nothing
End Sub

... cela fonctionne : le seul problème est l'ordre dans lequel je récupère
les noms des répertoires et fichiers : voilà ce qu'il me donne :

Sous-sous-REP1;

ImageSous-REP1.bmp;

Sous-REP1;

Document-REP1.doc;ImageREP1.bmp;



SousREP2;

DocREP2.doc;

REPERTOIRE1;REPERTOIRE2;



Là ou j'aimerais bien avoir quelque chose qui redonne un peu l'organisation
des choses, du genre :

REPERTOIRE1

- Document-REP1.doc;

- ImageREP1.bmp;

- Sous-REP1;

-- ImageSous-REP1.bmp;

-- Sous-sous-REP1;



REPERTOIRE2

- DocREP2.doc;

- SousREP2;



Des idées pour obtenir un tel résultat ?

Par avance, ma reconnaissance :o)

Sonia.
Avatar
Michel_D
Merci pour ces éclaircissements...
De mon côté j'avance, mais pas encore obtenu tout à fait ce que je
souhaitais (je ne sais pas si c'est possible...?)
Voilà ce que finalement j'ai écris pour récupérer les données dans mon champ
:

Sub test()
Call ListerSousRepertoires(LeNomDeTonDossier)
End Sub

Sub ListerSousRepertoires(spath As String)
Dim fso As Object
Dim Directory As Object
Dim SubFolders As Object
Dim Folders As Object
Dim strtmp

Set fso = CreateObject("Scripting.FileSystemObject")
Set Directory = fso.GetFolder(spath)
Set SubFolders = Directory.SubFolders

For Each Folders In SubFolders
Debug.Print strtmp & Folders.name
strtmp = strtmp & Folders.name & ";"
Call ListerSousRepertoires(Folders.Path)
Call ListerFichiers(Folders.Path)

Next Folders
Me![Description] = Me![Description] & vbCrLf & strtmp

Set Folders = Nothing
Set SubFolders = Nothing
Set fso = Nothing
Set Directory = Nothing
End Sub

Sub ListerFichiers(spath As String)

Dim fso As Object
Dim Repertoire As Object
Dim SubFolder As Object
Dim File, Files As Object
Dim strtmp
Dim recupfichiers As String

Set fso = CreateObject("Scripting.FileSystemObject")
Set Repertoire = fso.GetFolder(spath)
Set Files = Repertoire.Files

For Each File In Files
Debug.Print strtmp & File.name
strtmp = strtmp & File.name & ";"

Next File
Me![Description] = Me![Description] & vbCrLf & strtmp

Set Files = Nothing
Set File = Nothing
Set SubFolder = Nothing
Set fso = Nothing
Set Repertoire = Nothing
End Sub

.... cela fonctionne : le seul problème est l'ordre dans lequel je récupère
les noms des répertoires et fichiers : voilà ce qu'il me donne :

Sous-sous-REP1;

ImageSous-REP1.bmp;

Sous-REP1;

Document-REP1.doc;ImageREP1.bmp;



SousREP2;

DocREP2.doc;

REPERTOIRE1;REPERTOIRE2;



Là ou j'aimerais bien avoir quelque chose qui redonne un peu l'organisation
des choses, du genre :

REPERTOIRE1

- Document-REP1.doc;

- ImageREP1.bmp;

- Sous-REP1;

-- ImageSous-REP1.bmp;

-- Sous-sous-REP1;



REPERTOIRE2

- DocREP2.doc;

- SousREP2;



Des idées pour obtenir un tel résultat ?

Par avance, ma reconnaissance :o)

Sonia.



Bon analysont un peu la méthode employée :

En premier tu appelle la procédure "ListerSousRepertoires" avec en paramêtre
le nom du répertoire origine puis tu effectue un traitement récursif (liste)
sur les éventuels sous-répertoires et lorsqu'il n'y a plus de
sous-répertoire tu liste les fichiers.

et toi tu voudrais lister d'abord les fichiers du répertoire à analyser puis
traiter de manière récursive les éventuels sous-répertoire, donc il va falloir
placer la procédure qui liste les fichiers avant la boucle qui traite les
sous-répertoires.

Avatar
gogo
Bon, les choses avançent...
Voilà les petites modifications faites :
Sub ListerSousRepertoires(spath As String)

Dim fso As Object
Dim Directory As Object
Dim SubFolders As Object
Dim Folders As Object
Dim strtmp

Set fso = CreateObject("Scripting.FileSystemObject")
Set Directory = fso.GetFolder(spath)
Set SubFolders = Directory.SubFolders

For Each Folders In SubFolders
Debug.Print strtmp & Folders.name

strtmp = strtmp & Folders.name & ";"
Me![Description] = Me![Description] & vbCrLf & strtmp

Call ListerFichiers(Folders.Path)
Call ListerSousRepertoires(Folders.Path)

Next Folders

Set Folders = Nothing
Set SubFolders = Nothing
Set fso = Nothing
Set Directory = Nothing
End Sub

Sub ListerFichiers(spath As String)

Dim fso As Object
Dim Repertoire As Object
Dim SubFolder As Object
Dim File, Files As Object
Dim strtmp
Dim recupfichiers As String

Set fso = CreateObject("Scripting.FileSystemObject")
Set Repertoire = fso.GetFolder(spath)
Set Files = Repertoire.Files

For Each File In Files
Debug.Print strtmp & File.name
strtmp = strtmp & File.name & ";"

Next File
Me![Description] = Me![Description] & vbCrLf & strtmp

Set Files = Nothing
Set File = Nothing
Set SubFolder = Nothing
Set fso = Nothing
Set Repertoire = Nothing
End Sub


.... qui me donnent :

REPERTOIRE1;
DocREP1.doc;ImageREP1.bmp;
Sous-REP1;
imageSous-REP1.bmp;
Sous-sous-REP1;

REPERTOIRE1;REPERTOIRE2;
docREP2.doc;
SousREP2;
base-sousREP2.mdb;

... presque parfait quoi :o) Sinon la répétition du noms de l'ensemble des
sous-répertoires de premier niveaux !
On pourrait faire avec car la logique est claire et la correction manuelle
facile, mais bon... et là encore je bloque...
Autre idée ?
Merci encore,
Sonia.




Bon analysont un peu la méthode employée :

En premier tu appelle la procédure "ListerSousRepertoires" avec en
paramêtre
le nom du répertoire origine puis tu effectue un traitement récursif
(liste)
sur les éventuels sous-répertoires et lorsqu'il n'y a plus de
sous-répertoire tu liste les fichiers.

et toi tu voudrais lister d'abord les fichiers du répertoire à analyser
puis
traiter de manière récursive les éventuels sous-répertoire, donc il va
falloir
placer la procédure qui liste les fichiers avant la boucle qui traite les
sous-répertoires.



Avatar
Michel_D
Voici comment je ferais :

Dim sTmp As String

Sub Test()
Dim sChemin As String

sChemin = "C:TonChemin"
sTmp = ""
Lister sChemin
Debug.Print sTmp
End Sub

Sub Lister(sPath)
Dim oFso As Object
Dim oDc As Object
Dim oD As Object
Dim oF As Object

Set oFso = CreateObject("Scripting.FileSystemObject")
If oFso.FolderExists(sPath) Then
Set oDc = oFso.GetFolder(sPath)
sTmp = sTmp & Mid(sPath, InStrRev(sPath, "") + 1) & ";" & vbCrLf
For Each oF In oDc.Files
sTmp = sTmp & oF.Name & ";"
Next
sTmp = sTmp & vbCrLf
Set oF = Nothing
For Each oD In oDc.SubFolders
Lister sPath & "" & oD.Name
Next
End If

Set oFso = Nothing
Set oDc = Nothing
Set oD = Nothing
End Sub
Avatar
gogo
Bonsoir,
Merci beaucoup pour ton intérêt, mais pas encore tout à fait ça : pas
l'ordre souhaité en tous les cas... car voilà ce que cela donne :

Sous-sous-REP1;

Sous-REP1;
imageSous-REP1.bmp;

REPERTOIRE1;
DocREP1.doc;ImageREP1.bmp;

SousREP2;
base-sousREP2.mdb;

REPERTOIRE2;
docREP2.doc;

REPERTOIRE3;
ImageREP3.bmp;

RIBPI_C_1979_01;

... je vais voir si je peux faire mieux (ça m'étonnerait quand même, mais
bon)
Cordialement,
Sonia.
Avatar
Michel_D
re,

Bonsoir,
Merci beaucoup pour ton intérêt, mais pas encore tout à fait ça : pas
l'ordre souhaité en tous les cas... car voilà ce que cela donne :

Sous-sous-REP1;

Sous-REP1;
imageSous-REP1.bmp;

REPERTOIRE1;
DocREP1.doc;ImageREP1.bmp;

SousREP2;
base-sousREP2.mdb;

REPERTOIRE2;
docREP2.doc;

REPERTOIRE3;
ImageREP3.bmp;

RIBPI_C_1979_01;

.... je vais voir si je peux faire mieux (ça m'étonnerait quand même, mais
bon)
Cordialement,
Sonia.



Essaye avec le code suivant :



Dim oFso As Object
Dim sTmp As String
Dim sChemin As String

Sub Test()
Set oFso = CreateObject("Scripting.FileSystemObject")
sChemin = "C:TonChemin"
sTmp = ""
Lister sChemin
Debug.Print sTmp
Set oFso = Nothing
End Sub

Sub Lister(sPath)
Dim oDc As Object
Dim oD As Object
Dim oF As Object

If oFso.FolderExists(sPath) Then
Set oDc = oFso.GetFolder(sPath)
If sPath<>sChemin Then
sTmp = sTmp & Mid(sPath, InStrRev(sPath, "") + 1) & ";" & vbCrLf
For Each oF In oDc.Files
sTmp = sTmp & oF.Name & ";"
Next
sTmp = sTmp & vbCrLf
Set oF = Nothing
End If
For Each oD In oDc.SubFolders
Lister sPath & "" & oD.Name
Next
End If

Set oDc = Nothing
Set oD = Nothing
End Sub

Avatar
gogo
Bonjour Michel,
Suite du feuilleton, mais quelle patience ;o)
Bon, j'ai un problème avec ta proposition : à quoi cela sert ton sub test()
? et comment l'utilises-tu ? (la première fois je ne l'ai carrément pas
ajouté car je ne voyais pas à quoi il servait : j'ai ajouté les déclarations
à Lister
Pour info j'associe directement Lister(spath) à click sur un bouton...
Et où je les mets ces déclarations que tu indiques au début ?
Dim oFso As Object
Dim sTmp As String
Dim sChemin As String


Merci de m'éclairer,
Sonia.


"Michel_D" a écrit dans le message de
news:
re,

Bonsoir,
Merci beaucoup pour ton intérêt, mais pas encore tout à fait ça : pas
l'ordre souhaité en tous les cas... car voilà ce que cela donne :

Sous-sous-REP1;

Sous-REP1;
imageSous-REP1.bmp;

REPERTOIRE1;
DocREP1.doc;ImageREP1.bmp;

SousREP2;
base-sousREP2.mdb;

REPERTOIRE2;
docREP2.doc;

REPERTOIRE3;
ImageREP3.bmp;

RIBPI_C_1979_01;

.... je vais voir si je peux faire mieux (ça m'étonnerait quand même,
mais bon)
Cordialement,
Sonia.



Essaye avec le code suivant :



Dim oFso As Object
Dim sTmp As String
Dim sChemin As String

Sub Test()
Set oFso = CreateObject("Scripting.FileSystemObject")
sChemin = "C:TonChemin"
sTmp = ""
Lister sChemin
Debug.Print sTmp
Set oFso = Nothing
End Sub

Sub Lister(sPath)
Dim oDc As Object
Dim oD As Object
Dim oF As Object

If oFso.FolderExists(sPath) Then
Set oDc = oFso.GetFolder(sPath)
If sPath<>sChemin Then
sTmp = sTmp & Mid(sPath, InStrRev(sPath, "") + 1) & ";" & vbCrLf
For Each oF In oDc.Files
sTmp = sTmp & oF.Name & ";"
Next
sTmp = sTmp & vbCrLf
Set oF = Nothing
End If
For Each oD In oDc.SubFolders
Lister sPath & "" & oD.Name
Next
End If

Set oDc = Nothing
Set oD = Nothing
End Sub




1 2 3