1. Accueil
  2. Tous les snippets
  3. Snippets Visual Basic / VB.NET
  4. Routine dir récursive pour obtenir la liste de tous les fichiers dans un répertoire et ses sous-dossiers avec la taille en o

Routine dir récursive pour obtenir la liste de tous les fichiers dans un répertoire et ses sous-dossiers avec la taille en o

Soyez le premier à donner votre avis sur cette source.

Snippet vu 9 749 fois - Téléchargée 17 fois

Commenter

Contenu du snippet

Utilise la structure TypeFichier (nom, repertoire, taille)
Stockage de cette liste dans un tableau global : ListeFichiers()

dans la sub "liste_fichiers",
modifier le nom du Dossier à lister stocké dans la variable: Dossier

Routine récursive : Dir_Fichiers
Attention : la fonction VB "Dir" n'est pas récursive, on doit donc repositionner un pointeur sur la dernière entrée lue par la fonction "Dir" avant de poursuivre la lecture des entrées.

Source / Exemple : 


Option Explicit  'déclaration obligatoire des variables

Public Type TypeFichier
    nom As String
    repertoire As String
    taille As Long
End Type

Public ListeFichiers() As TypeFichier
'

Public Sub liste_fichiers()
    
    Dim Dossier As String
    Dim NbreFicTot As Long
    
    Debug.Print String(100, "*")
    
    ReDim ListeFichiers(0 To 0) As TypeFichier
    
    Dossier = "D:\transfert"
    
    Call Dir_Fichiers(Dossier)
        
    NbreFicTot = UBound(ListeFichiers)
    MsgBox NbreFicTot & " fichiers", vbInformation, "Fin Liste Fichiers"
    
End Sub

Public Sub Dir_Fichiers(ByVal Dossier As String)
    
    'utilise la Variable globale : 'ListeFichiers() as TypeFichier
    
    Dim Chemin As String
    Dim FichierLu As String
    Dim NbreFichiersLus As Long, NbreFichiers As Long
    Dim i As Long
    
    NbreFichiersLus = 0
    Chemin = Dossier + "\"
    'liste les fichiers et les dossiers avec l'option vbDirectory
    FichierLu = Dir(Chemin, vbDirectory)
    Do While FichierLu <> ""
        NbreFichiersLus = NbreFichiersLus + 1
        If FichierLu <> "." And FichierLu <> ".." Then
            If (GetAttr(Chemin & FichierLu) And vbDirectory) = vbDirectory Then
                'c'est un répertoire, on l'examine de facon récursive
                Debug.Print "Dossier: " & Chemin & FichierLu & "  " & String(70, "-")
                Call Dir_Fichiers(Chemin & FichierLu)
                Debug.Print "Fin Dossier: " & Chemin & FichierLu & "  " & String(70, "-")
                'après avoir examiné le sous-dossier, il faut repositionner Dir sur l'entrée suivante
                'car la fonction dir n'est pas récursive et a donc perdue la dernière position
                'on réinitialise donc Dir et repositionne le flag à la bonne place avec NbreFichiersLus
                FichierLu = Dir(Chemin, vbDirectory)
                For i = 1 To NbreFichiersLus - 1
                    FichierLu = Dir
                Next i
            Else
                'c'est un fichier, on le met dans la liste globale
                'augmente de 1 la taille de la liste en préservant le contenu du tableau de la liste
                Debug.Print FichierLu
                NbreFichiers = UBound(ListeFichiers) + 1
                ReDim Preserve ListeFichiers(0 To NbreFichiers) As TypeFichier
                'ajoute le fichier à la liste
                ListeFichiers(NbreFichiers).nom = FichierLu
                ListeFichiers(NbreFichiers).repertoire = Chemin
                ListeFichiers(NbreFichiers).taille = FileLen(Chemin & FichierLu)
            End If
        End If
        'passe à l'entrée suivante de la fonction Dir
        FichierLu = Dir
    Loop
    
End Sub

Conclusion :


Toutes les étapes sont affichées en mode debug à l'exécution.
Attention les fichiers ne sont pas triés, même entre les répertoire car la fonction Dir ne trie pas les fichiers.
Utiliser ensuite le tableau pour faire vos traitement de tri par dossier etc...

A voir également

Ajouter un commentaire

Commentaires

Signaler
Messages postés
62
Date d'inscription
samedi 10 janvier 2009
Statut
Membre
Dernière intervention
30 octobre 2012
Bonjour,

Il est vrai que la fonction Scan (exemple ci-dessus) pose problème
pour des fichiers en réseau (\\remotehost\share\fichier.txt)
Exemple: pour scanner un dossier en réseau de 200 fichiers il faut plus de 10 mn alors que pour
le même dossier en local il ne faut que quelques secondes

Même si le temps d'accès à un fichier en réseau est plus long que pour un fichier
en local, je ne comprends pas pourquoi dans ce cas le scan est aussi lent.
Signaler
Messages postés
33
Date d'inscription
mercredi 1 mars 2006
Statut
Membre
Dernière intervention
24 février 2008
L'API ok, perf. avantage.
Simplicité d'écriture le code VB, mais limité à taille en octets sur 32 bits (limite VB6)
donc fichier(s) ou addition de fichiers dans un dossier inférieures à 2 go (environ)
Le FSO (filesystemObject) est simple à utiliser / coder par rapport à l'api et fonctionne avec
une property size sur 64 bits.

A noter qu'on ne peut ouvrir / gérer un fichier avec une syntaxe UNC (\\remotehost\share)
\fichier.txt) en DOT.NET l'utilisation UNC, par exemple pour créé un dossier fonctionne.
Signaler
Messages postés
62
Date d'inscription
samedi 10 janvier 2009
Statut
Membre
Dernière intervention
30 octobre 2012
Un exemple qui utilise la fonction Scan

Permet de mettre tous les sous-dossiers d'un dossier dans une liste (ListDoss)
et tous les fichiers des sous-dossiers dans une autre liste (ListFich)
Il faut initialiser les 2 listes (ListView) et référencer microsoft scripting runtime

Dim Dossier As Folder, Sousdossier As Folder, Fichier As File
Dim fso As FileSystemObject

Private Sub Form_Load()

Scan_Dossier "c:\MonDossier"

End Sub

Sub Scan_Dossier(ByVal Dossier As Folder)

On Error GoTo Erreur

Dim PlusDossier as Boolean

For Each Fichier In Dossier.Files
If PlusDossier = False Then Set itmx ListDoss.ListItems.Add(, , Dossier): PlusDossier True
End If
Set itmy = ListFich.ListItems.Add(, , Fichier)
Next

PlusDossier = False
For Each Sousdossier In Dossier.SubFolders
Scan_Dossier Sousdossier
Next

Set itmx = Nothing
Set itmy = Nothing

Exit Sub

Erreur:
MsgBox Err.Number & vbCrLf & Err.Description
Err.Clear

End Sub
Signaler
Messages postés
17286
Date d'inscription
mercredi 2 janvier 2002
Statut
Modérateur
Dernière intervention
23 décembre 2019
 62
Non, JJDai, ce n'est pas une option !

fileSCRIPTINGobject le bien nommé est a reserver au scripting
trop lent en dehors...

ca fonctionne, mais c'est lent et ajoutes une dépendance
Signaler
Messages postés
291
Date d'inscription
vendredi 21 février 2003
Statut
Membre
Dernière intervention
13 mars 2015
Un petit exemple:

Option Explicit

Sub test()
listerDossiers ("c:")
End Sub

Sub listerDossiers(Optional sFolder As String = "")
Dim fso As FileSystemObject
Dim fld As Folder
Dim fldParent As Folder

Set fso = New FileSystemObject
Set fldParent = fso.GetFolder(sFolder)

For Each fld In fldParent.SubFolders
Debug.Print fld.Path & "-" & fld.Size
Call listerDossiers(fld.Path)
DoEvents
Next

End Sub

Il faut bien sur référencer microsoft scripting runtime

JJDai
Afficher les 8 commentaires
S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.