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

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.

Codes Sources

A voir également

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.