Lister repertoires sous repertoires et fichiers

[franck17]

Bonjour a tous

Mon probleme,modifier ce code pour lister les repertoires sous repertoires et fichiers pour recuper les fichiers .png
Merci de votre aide
bonne journée

Sub Lister(NumLigne&, Chemin As String, Optional Prefixe$ = "*.png")
Dim NomFichier As String
NomFichier = Dir(Chemin & Prefixe)
Do While Len(NomFichier) > 0
Cells(NumLigne, 1) = Chemin & NomFichier
NumLigne = NumLigne + 1
NomFichier = Dir
Loop
End Sub

Sub Demarrer()
Dim Chemin
Chemin = Application.GetOpenFilename("Fichier images (*.png), *.png")
If Chemin = False Then Exit Sub
F1.Columns(1).Clear
Lister 14, Left(Chemin, InStrRev(Chemin, "\"))
End Sub

 

[excalibur]

Re : Lister repertoires sous repertoires et fichiers

bonjour franck le forum une macro qui marche si tu peus t en inspirer
Sub List1()
On Error Resume Next
Application.ScreenUpdating = False
Dim Directory As Variant
Dim r As Variant
Dim i As Variant
'Directory = Range("f1").Value
Directory = "d:\"
r = 1
Cells(r, 1) = "FileName"
r = r + 1
On Error Resume Next
With Application.FileSearch
.NewSearch
.LookIn = Directory
'.Filename = "*.*"'tous type de fichiers
.Filename = "*.png"
.SearchSubFolders = False
.Execute
For i = 1 To .FoundFiles.Count
Cells(r, 1) = .FoundFiles(i)
r = r + 1
Next i
End With
End Sub'salutations

 

[franck17]

Re : Lister repertoires sous repertoires et fichiers

Salut Excalibur

merci de ta reponse
le code marche tres bien mais je voudrais aussi recuperer les fichiers des sous repertoires et vu mon niveau en vba je ne trouve pas la solution
si tu connait la solution merci d'avance
salutation

 

[franck17]

Re : Lister repertoires sous repertoires et fichiers

Merci Merci Excalibur

Ca marche aussi pour les sous repertoires
.SearchSubFolders = True

Grand merci et bonne journée

 

[allegro50]

Re : Lister repertoires sous repertoires et fichiers

Bonjour

C'est super ca fait comme Windows mais en plus long et avec moins d'info !!

non je joke !! il est bien ton code

A plus