Lister fichiers dans dossier et sous-dossiers avec la fonction Dir

**modus57** · 17/10/2019, 09h52

Bonjour à tous.

Je voudrais lister de façon récursive les fichiers de mes dossiers et sous-dossiers dans la feuille active.

Le code suivant permet lister les fichiers du répertoire sélectionné :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Application.ScreenUpdating = False
    Dim myPath As String, myFile As String    
    Call DeleteLignesListe    
    dossier = ChoixDossier()
    If dossier = "" Then Exit Sub
    myPath = dossier
    myFile = Dir(dossier & "\")    
    c = 1
    Do While myFile <> ""
        Cells(c + 1, 1) = dossier & "\" & myFile
        Cells(c + 1, 2) = myFile
        myFile = Dir()
        c = c + 1
    Loop
    Columns("A:B").AutoFit
    Application.ScreenUpdating = True

Comment faire pour lister les fichiers dans tous les sous-répertoires.

Merci pour votre aide.

Cordialement.

**dede_bo** · 17/10/2019, 15h08

Bonjour,

Voici une solution que je peux te proposer:

Avant d'exécuter le code, il faut activer "Microsoft Scripting RunTime" que vous trouverez dans le menu "Tools" / Reference.
Dans la partie globale du module, ne pas oublier d'ajouter

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 
 Dim ct as integer

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
 
Function GetFiles(Repertoire As String) As String
    Dim result As String
    Dim MyFSO As FileSystemObject
    Dim MyFile As File
    Dim MyFolder As Folder
    Dim MySubFolder As Folder
 
 
    ' Crée un objet File System
 
    Set MyFSO = New Scripting.FileSystemObject
 
    If Repertoire <> "" Then
 
        ' Je lui donne le nom du répertoire à parcourir
 
        Set MyFolder = MyFSO.GetFolder(Repertoire)
 
       ' Je regarde si le répertoire contient des sous-répertoire
 
        For Each MySubFolder In MyFolder.SubFolders
 
            ' Ici, cette boucle est utilisé simplement pour l'affichage (indentation)
            For i = 1 To ct
                Debug.Print "    ";
            Next i
 
            ' J'affiche le nom du réperoire en cours
            Debug.Print "Répertoire: " & MySubFolder.Name
 
           ' Utiliser pour l'indentation
            ct = ct + 1
 
            ' Rappelle la fonction récursivement
 
            txt = GetFiles(MyFolder & "\" & MySubFolder.Name)
 
 
            ' J'affiche la liste des fichiers du répertoire en cours
 
            For Each MyFile In MySubFolder.Files
 
                ' Utilisé pour l'indentation
 
                For i = 1 To ct
                    Debug.Print "    ";
                Next i
 
                ' Affiche le nom, la taille et le type de fichier.
 
                Debug.Print "   - " & MyFile.Name, MyFile.Size, MyFile.Type
 
            Next MyFile
 
            ' Je sépare d'une ligne vide pour le prochain répertoire (simple question de clarté d'affichage) 
 
            Debug.Print
 
        Next MySubFolder
 
    End If
 
    ' Une fois la lecture du répertoire en cours terminé je réduit de "1" pour l'indentation
 
    ct = ct - 1
End Function

Pour utiliser cette fonction : Dans la partie immediate : ?GetFiles("Le nom du répertoire de départ")

Voilà, J'espère que c'est cela que tu as besoin

Bon après-midi

André

**modus57** · 17/10/2019, 16h44

Bonjour dede_bo.

Merci de ta réponse.

J'ai déjà testé avec (Scripting.FileSystemObject), mais avec la fonction Dir c'est tout de même bien plus rapide.

Notamment pour pour lister C:\...\...\Documents ça fonctionne très bien, par contre ça bug avec (Scripting.FileSystemObject).

**modus57** · 19/10/2019, 16h16

Bonjour à tous.

Oups ! même pas un petit indice ou une petite piste.

**modus57** · 19/10/2019, 23h46

Bonsoir à tous.

Je reviens vers vous pour essayer d'avancer.

Je ne comprends pas pourquoi avec mon code, lorsqu'on choisit un sous répertoire de "C:\Users\...\Documents\" cela liste tous les fichiers de ce sous-répertoire et de tous les sous-répertoires.

Par contre lorsqu'on choisit "C:\Users\...\Documents\" ou la bibliothèque "Documents" cela liste seulement les fichiers de ce répertoire et ignore les fichiers de tous les autres sous-répertoires ?

Avez-vous une explication, merci d'avance pour vos réponses.

**Patrice740** · 20/10/2019, 10h47

Bonjour,

Pour lister les fichiers avec Dir, j'utilise ceci :

Code VBA :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
Option Explicit
Option Private Module
' Note : il faut activer les références (dans Outils > Références ...) à :
' - Microsoft Scripting Runtime
' - Microsoft Shell Controls And Automation
Public Sub Lister_Fichiers()
' Liste les fichiers d'un répertoire et ses sous-répertoires dans une feuille Excel
Dim s As Shell32.Shell            'Shell
Dim c As Shell32.Folder           'Choix de recherche dossier
Dim p As String                   'Chemin (Path) du dossier
Dim m As String                   'Message de la boite de dialogue
Dim f As Scripting.Dictionary     'Fichiers
Dim w As Excel.Workbook           'Classeur
Dim r As Excel.Range              'Plage
  'Afficher la boite de dialogue avec l'arborescence
  On Error Resume Next
  m = "Choisir le répertoire à analyser :"
  Set s = New Shell32.Shell
  Set c = s.BrowseForFolder(0, m, 513)
  p = c.Items.Item.Path
  On Error GoTo 0
  'Fichiers du répertoire
  If p <> "" Then
    Set f = New Dictionary
    Call ListerDossier(f, p)
    If f.Count > 0 Then
      Set w = Application.Workbooks.Add(xlWBATWorksheet)
      Set r = w.Worksheets(1).Range("A1:B1")
      With r
        'Titres
        .Font.Bold = True
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Cells(1, 1).Formula = "Fichier concerné"
        .Cells(1, 2).Formula = "Chemin complet du fichier"
        'Liste fichiers
        .Offset(1).Cells(1, 1).Resize(f.Count) = Application.Transpose(f.Items)
        .Offset(1).Cells(1, 2).Resize(f.Count) = Application.Transpose(f.Keys)
        .EntireColumn.AutoFit
      End With
    End If
  End If
  Set s = Nothing
  Set c = Nothing
End Sub
Sub ListerDossier(f As Scripting.Dictionary, ByVal p As String)
Dim d As Scripting.Dictionary     'Dossiers
Dim k As Variant                  'Clé
Dim n As String                   'Nom
  Set d = New Dictionary
  p = p & "\"
  n = Dir(p, vbDirectory)
  ' Liste des sous-répertoires
  Do While n <> ""
    If n <> "." And n <> ".." Then
      If (GetAttr(p & n) And vbDirectory) = vbDirectory Then
        d(p & n) = n
      End If
    End If
    n = Dir
  Loop
  ' Lister les fichiers
  n = Dir(p)
  Do While n <> ""
    f(p & n) = n
    n = Dir
  Loop
  ' Lister chaque sous-répertoire
  If d.Count > 0 Then
    For Each k In d.Keys
       n = k
       Call ListerDossier(f, n)
    Next k
  End If
End Sub

**modus57** · 20/10/2019, 13h43

Bonjour Patrice 740.

Merci pour ta réponse, j'ai testé ton code.

Lorsqu'on choisit "C:\Users\...\Documents\" ou la bibliothèque "Documents" ça génère une "Erreur d'exécution 53 : Fichier introuvable".

Un petit bug à la ligne suivante If (GetAttr(p & n) And vbDirectory) = vbDirectory Then.

Par contre lorsqu'on choisit un sous répertoire de "C:\Users\...\Documents\" cela liste tous les fichiers de ce sous-répertoire choisi et de tous ses sous-répertoires.

**Patrice740** · 20/10/2019, 19h48

Bonjour,

Envoyé par modus57

Bonjour Patrice 740.
Merci pour ta réponse, j'ai testé ton code.
Lorsqu'on choisit "C:\Users\...\Documents\" ou la bibliothèque "Documents" ça génère une "Erreur d'exécution 53 : Fichier introuvable".
Un petit bug à la ligne suivante If (GetAttr(p & n) And vbDirectory) = vbDirectory Then.

Lors du bug, p donne le répertoire et n le fichier.
Vérifie que le nom du fichier ne contient pas de caractère non reconnu par Dir.
Je viens d'avoir le problème avec un fichier qui contenait un è codé sur 2 caractères qui étaient lus par Dir comme e` i.e. Chr$(101) & Chr$(96) au lieu de è i.e. Chr$(232)
En modifiant le nom du fichier pour y remettre un è standard, le problème disparaît/

**modus57** · 21/10/2019, 12h05

Bonjour.

J'ai testé ça fonctionne et en plus j'ai constaté que tous les fichiers cachés, système et avec les extensions suivantes .db,.ptn,.ptn2,.ini2,.ppinfocache ne sont pas listés.

**Igloobel** · 21/10/2019, 12h47

Bonjour,

celle faite par Patrice740 répond à ta demende

Cependant si tu peux t'abstenir de dir pour la gestion des dossiers sous-dossiers va voir ce fil

https://www.developpez.net/forums/d9...sous-dossiers/

Et je te conseille ce tuto aussi :

https://warin.developpez.com/access/fichiers/

**modus57** · 21/10/2019, 18h54

Bonsoir Igloobel.

Je vais voir du côté des liens que tu m'a communiqué.

Entre temps j'ai fouiné un peut plus et j'ai trouvé également une bonne procédure avec la fonction Dir de Patrick Toulon sur ce lien https://www.developpez.net/forums/d1...esystemobject/ qui est rapide et fonctionne très bien.

Lister fichiers dans dossier et sous-dossiers avec la fonction Dir

Macros et VBA Excel

Discussions similaires

Partager

Partager