Propriété d'un repertoire (traverse les sous repertoires récursivement)

Soyez le premier à donner votre avis sur cette source.

Vue 5 596 fois - Téléchargée 393 fois

Télécharger le projet
Commenter

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.

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.
Télécharger le projet

Codes Sources

A voir également

Ajouter un commentaire

Commentaires

Signaler
cs_PaTaTe
Messages postés
1878
Date d'inscription
mercredi 21 août 2002
Statut
Contributeur
Dernière intervention
7 janvier 2019
 -
Code pas clair, il manque la form (la moindre des chose est de l'ajouter. Si c'est pour balancer des trucs incomplets gardes-les pour toi tout simplement). Sinon à part ça les 3 options donne le même résultat.
Signaler
dparize
Messages postés
6
Date d'inscription
mercredi 2 juin 2004
Statut
Membre
Dernière intervention
22 décembre 2014
 -
crée une form
place un commandbutton
place 3 optionbutton
place un textbox
rajoute "End Sub" à la fin
et tout fonctionne.
Merci à MarsuGl
Signaler
quickynico
Messages postés
10
Date d'inscription
jeudi 22 août 2002
Statut
Membre
Dernière intervention
3 novembre 2004
 -
si je puis me permettre tu as po mis le form1 :S
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.