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 10 691 fois - Téléchargée 18 fois
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.
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...
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
- Dir recursif
- Basic dir - Meilleures réponses
- Vb dir - Meilleures réponses
- Dir récursif multi-filtres en une seule passe [module / module de classe] - Codes sources - Visual Basic / VB.NET (Modules)
- Tours de hanoi algorithme récursif python - Guide
- Fonction puissance recursive - Conseils pratiques - PHP
- Fibonacci python recursive - Guide
- Fonction recursive en c - Guide
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.
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.
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
- Messages postés
-
17286
- Date d'inscription
- mercredi 2 janvier 2002
- Statut
- Modérateur
- Dernière intervention
- 23 décembre 2019
69fileSCRIPTINGobject le bien nommé est a reserver au scripting
trop lent en dehors...
ca fonctionne, mais c'est lent et ajoutes une dépendance
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
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.