XL 2013 Lister les fichier d'un dossier et de tous les sous dossiers du dossier "parent"

Florian53

XLDnaute Impliqué
Bonjour à tous,

Je souhaiterais pouvoir via un fichier excel lister tous les fichiers qui ce trouve dans un dossier ainsi que les fichiers qui se trouve dans les sous dossiers du dossier "parent".

J'ai trouvé ce lien sur le net : https://vbaforexcel.wordpress.com/2013/09/06/lister-les-fichiers-et-sous-dossiers-dun-dossier/ qui explique très bien comment faire.

J'ai réussi à le faire fonctionner à mon utilisation par contre il liste que les fichiers du dossier mais pas ceux des sous dossiers.

je pense qu'il faut partir de ce code :

Code:
Sub Fichiers()
Application.ScreenUpdating = False
Dim myPath As String, myFile As String

myPath = ThisWorkbook.Path
myFile = Dir(myPath & "\*.xls*")

c = 1
Do While myFile <> ""
    Cells(c, 1) = myFile
    myFile = Dir()
    c = c + 1
Loop

End Sub

Pouvez vous m'éclairer svp.

Cordialement
 

Florian53

XLDnaute Impliqué
Re : Lister les fichier d'un dossier et de tous les sous dossiers du dossier "parent"

Merci Pierrot:

Le code que tu as mis sur le fil fonctionne très bien:

Code:
Option Explicit
Sub ListeFichiersRepert()
Dim Fso  As Object
Dim MonRepertoire As String, f As Object, x As Integer
Dim f1 As  Object, f2 As Object
Set Fso =  CreateObject("Scripting.FileSystemObject")
MonRepertoire =  "C:\Users\Moi\Documents\Dossier Excel"
x = 1
For Each f In  Fso.GetFolder(MonRepertoire).Files
    Cells(x, 1).Value = f.Name
    x =  x + 1
Next f
x = 1
For Each f1 In  Fso.GetFolder(MonRepertoire).SubFolders
    Cells(x, 2).Value =  f1.Name
    x = x + 1
    For Each f2 In f1.Files
        Cells(x - 1,  3).Value = f2.Name
        x = x + 1
    Next f2
    x = x - 1
Next  f1
End Sub

Est-il possible de l'adapter afin qu'il me liste que les fichiers excel de type xls ou xlsm ?
 

MJ13

XLDnaute Barbatruc
Re : Lister les fichier d'un dossier et de tous les sous dossiers du dossier "parent"

Bonjour Florian, Pierrot

On peut partir d'un code de ce type:

Code:
Sub ListeFichiersAll()
  TousLesDossiers "C:\Temp\", 1
   DirFichiers
 End Sub
Private 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

Private Sub DirFichiers()
For Each cell In Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row)
cell.Select
Fichiers
Next
End Sub
Private Sub Fichiers()
Application.ScreenUpdating = False
Dim myPath As String, myFile As String

myPath = ActiveCell.Value 'ThisWorkbook.Path
myFile = Dir(myPath & "\*.xls*")

c = 2
Do While myFile <> ""
    'Cells(c, 1) = myFile
    Cells(ActiveCell.Row, c) = myFile
    myFile = Dir()
    c = c + 1
Loop
End Sub
 

Florian53

XLDnaute Impliqué
Re : Lister les fichier d'un dossier et de tous les sous dossiers du dossier "parent"

Merci à vous,

@Pierrot : je ne vois pas ou il faut intégrer la partie de code supplémentaire :

Code:
     If f.Name Like "*.xls*" Then
        Cells(x, 1).Value = f.Name
        x = x + 1
     End If

@MJ13

J'ai essayé le code ça fonctionne bien par contre si dans un sous dossier il y a plusieurs fichiers il les mets en B2,C2,D2.... je voudrais que soit une liste c'est a dire dans la colonne "A" le chemin d’accès comme actuellement et dans la colonne "B" la liste des fichiers à la suite les uns en dessous des autres.

Donc forcément il y aura des doublons de chemins dans la colonne "A"

Et je voudrais aussi compliqué un peu la chose si vous n'y voyait pas inconvénient:

Je voudrais que la macro chercher les fichiers de type xls mais seulement si le début du fichier est par exemple: " Constante(variable).xls

Seulement les fichiers qui commencerons pas "constante" et de type xls seront listé.

Est ce possible.

Cordialement
 

Pierrot93

XLDnaute Barbatruc
Re : Lister les fichier d'un dossier et de tous les sous dossiers du dossier "parent"

Re,
bonjour Michel:)

pas sur que tu ais vu le post #4... regarde dans l'aide vba se qui est dit sur l'opérateur "Like"... devrait solutionner ton problème...
 

Florian53

XLDnaute Impliqué
Re : Lister les fichier d'un dossier et de tous les sous dossiers du dossier "parent"

@Pierrot

J'ai été voir l'aide de "Like" mais je ne vois toujours pas où insérer le bout de code dans celui ci :

Code:
Option Explicit
Sub ListeFichiersRepert()
Dim Fso  As Object
Dim MonRepertoire As String, f As Object, x As Integer
Dim f1 As  Object, f2 As Object
Set Fso =  CreateObject("Scripting.FileSystemObject")
MonRepertoire =  "C:\Users\Moi\Documents\Dossier Excel"
x = 1
   [COLOR="#FF0000"]If f.Name Like "*.xls*" Then
        Cells(x, 1).Value = f.Name
        x = x + 1
     End If[/COLOR]
For Each f In  Fso.GetFolder(MonRepertoire).Files
    Cells(x, 1).Value = f.Name
    x =  x + 1
Next f
x = 1
For Each f1 In  Fso.GetFolder(MonRepertoire).SubFolders
    Cells(x, 2).Value =  f1.Name
    x = x + 1
    For Each f2 In f1.Files
        Cells(x - 1,  3).Value = f2.Name
        x = x + 1
    Next f2
    x = x - 1
Next  f1
End Sub

J'ai essayé comme ci dessus mais sa ne fonctionne pas
 

Florian53

XLDnaute Impliqué
Re : Lister les fichier d'un dossier et de tous les sous dossiers du dossier "parent"

Par contre pour la demande complémentaire je pense avoir compris :

Code:
 If f.Name Like "Constante*.xls*" Then
        Cells(x, 1).Value = f.Name
        x = x + 1
     End If

C'est bien ça ?
 

Florian53

XLDnaute Impliqué
Re : Lister les fichier d'un dossier et de tous les sous dossiers du dossier "parent"

J'ai essayé comme ceci mais sa ne fonctionne pas :

Code:
Option Explicit
Sub ListeFichiersRepert()
Dim Fso  As Object
Dim MonRepertoire As String, f As Object, x As Integer
Dim f1 As Object, f2 As Object
Set Fso = CreateObject("Scripting.FileSystemObject")
MonRepertoire = "G:\sourcing qualité\SAV\Analyse SAV"
x = 1
For Each f In Fso.GetFolder(MonRepertoire).Files
      If f.Name Like "Constante*.xls*" Then
        Cells(x, 1).Value = f.Name
        x = x + 1
     End If
Next f
x = 1
For Each f1 In Fso.GetFolder(MonRepertoire).SubFolders
    Cells(x, 2).Value = f1.Name
    x = x + 1
    For Each f2 In f1.Files
    If f2.Name Like "Constante*.xls*" Then
        Cells(x - 1, 3).Value = f2.Name
        x = x + 1
        End If
    Next f2
    x = x - 1
Next f1
End Sub
 

Florian53

XLDnaute Impliqué
Re : Lister les fichier d'un dossier et de tous les sous dossiers du dossier "parent"

Code:
Option Explicit
Sub ListeFichiersRepert()
Dim Fso  As Object
Dim MonRepertoire As String, f As Object, x As Integer
Dim f1 As Object, f2 As Object
Set Fso = CreateObject("Scripting.FileSystemObject")
MonRepertoire = "G:\sourcing qualité\SAV\Analyse SAV"
x = 1
For Each f1 In Fso.GetFolder(MonRepertoire).SubFolders
    Cells(x, 2).Value = f1.Name
    x = x + 1
    For Each f2 In f1.Files
    If f2.Name Like "Constante*.xls*" Then
        Cells(x - 1, 3).Value = f2.Name
        x = x + 1
        End If
    Next f2
    x = x - 1
Next f1
End Sub

Peux tu m'expliquer a quoi correpond f, f1, f2 ?

J'ai enlevé f car je pense ne pas en avoir besoin je dois listé dans les sous dossiers du dossier "parent"

J'ai essayé avec le code ci dessus mais j'ai tous les dossiers qui défile en "B1" et s’arrête sur le dernier dossier. je n'au aucun fichier qui s'affiche
 

Discussions similaires

Statistiques des forums

Discussions
315 104
Messages
2 116 251
Membres
112 697
dernier inscrit
administratif@ets-delestr