Propriété d'un repertoire (traverse les sous repertoires récursivement)
Soyez le premier à donner votre avis sur cette source.
Vue 5 715 fois - Téléchargée 409 fois
Description
Grace au code posté par Almandric, j'ai créé un module qui permettra de savoir la taille des fichiers d'un repertoire, le nombre de fichiers qu'il contient et le nombre de repertoires, eventuellement afficher tous les repertoires traversée et le nom des fichiers.
La fonction prends en compte les sous repertoires bien sur.
En gros c'est comme propriété de windows, mais en beaucoup moins rapide.
testé mais pas excessivement, contient peut etre des bugs merci de me contacter si c'est le cas.
J'espere que cela vous sera utile.
toute amélioration bienvenue
Si qqn sait comment faire qu'une fonction vb retourne un object, merci de me le dire.
La fonction prends en compte les sous repertoires bien sur.
En gros c'est comme propriété de windows, mais en beaucoup moins rapide.
Source / Exemple :
'structure contenant les informations sur le repêrtoire scanné
Public Type infos 'les nom des variables parlent d'eux memes
nbfichiers As Long
taillefichiers As Long
nbrep As Long
End Type
Public Function Init(ByRef StrucInit As infos, path As String, ByRef folder As Object) As String
Dim FileSystem As Object
Set FileSystem = CreateObject("Scripting.FileSystemObject")
Set folder = FileSystem.GetFolder(path)
StrucInit.nbfichiers = 0
StrucInit.taillefichiers = 0
StrucInit.nbrep = 0
End Function
Private Sub LstFichiers(ByRef Dossier As Object, ByRef StructInfo As infos, debugmode As Integer)
Dim Fichiers, Fichier As Object
Set Fichiers = Dossier.Files
For Each Fichier In Fichiers
DoEvents ' laisse la main a l'os pour affichage
StructInfo.nbfichiers = StructInfo.nbfichiers + 1
StructInfo.taillefichiers = StructInfo.taillefichiers + FileLen(Fichier)
If debugmode = 2 Then
Debug.Print Fichier
End If
Next
End Sub
Function LstDossier(ByVal DossierParent As Object, PremierPassage As Boolean, ByRef minfos As infos, debugmode As Integer) As infos
' degubmode=0 : pas d'affichage
' =1 : les repertoires
' =2 : les fichiers
' le tout dans la fenetre de débug de vb
Dim SousDossier As Object
Dim MonSousDossier As Object
'================liste les fichiers du rep de départ====
If PremierPassage = True Then ' si c'est le premier appel a la fonction
Call LstFichiers(DossierParent, minfos, debugmode)
End If
'=======================================================
Set SousDossier = DossierParent.subfolders
For Each MonSousDossier In SousDossier 'pour chaque sous rep..
DoEvents
minfos.nbrep = minfos.nbrep + 1
If debugmode = 1 Then
Debug.Print MonSousDossier
End If
'================liste les fichiers du sous repertoire==
Call LstFichiers(MonSousDossier, minfos, debugmode)
'=======================================================
minfos = LstDossier(MonSousDossier, False, minfos, debugmode) 'appel de soi meme
' la structure info retournée va remplacer celle passée a la fonc
Next
LstDossier = minfos ' retourne la structure avec les infos
End Function
------------------------------------------------------------------------------------
appel de la fonction :
Private Sub Command1_Click()
Dim chemin As String
Dim mesinfos As infos ' type de structure déclaré public dans le module
Dim folder As Object
Dim optDebug As Integer
chemin = Trim(Text1.Text) ' remplacer par le chemin a tester
If Option1.Value = True Then optDebug = 0
If Option2.Value = True Then optDebug = 2
If Option3.Value = True Then optDebug = 1
Call Init(mesinfos, chemin, folder) 'fonction d'initialisation
mesinfos = LstDossier(folder, True, mesinfos, optDebug) 'tout se fait ici
MsgBox "Fichiers: " & mesinfos.nbfichiers & vbCrLf & "Taille : " & mesinfos.taillefichiers & vbCrLf & "Repertoires : " & mesinfos.nbrep
Conclusion :
testé mais pas excessivement, contient peut etre des bugs merci de me contacter si c'est le cas.
J'espere que cela vous sera utile.
toute amélioration bienvenue
Si qqn sait comment faire qu'une fonction vb retourne un object, merci de me le dire.
Codes Sources
A voir également
- Propriété d'un repertoire (traverse les sous repertoires récursivement)
- Listing de répertoire récursif récalcitrant! ✓ - Forum - Java
- Répertoire téléphonique python - Guide
- Python : Répertoire téléphonique avec "multi-compte" - CodeS SourceS - Guide
- C# lister les fichiers d'un répertoire - Conseils pratiques - C# / .NET
- Python lister les fichiers d'un répertoire ✓ - Forum - Python
- Messages postés
-
2107
- Date d'inscription
- mercredi 21 août 2002
- Statut
- Contributeur
- Dernière intervention
- 19 février 2021
2place un commandbutton
place 3 optionbutton
place un textbox
rajoute "End Sub" à la fin
et tout fonctionne.
Merci à MarsuGl
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.