Soyez le premier à donner votre avis sur cette source.
Vue 5 894 fois - Téléchargée 426 fois
'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
2 août 2009 à 16:31
2 sept. 2004 à 15:38
place un commandbutton
place 3 optionbutton
place un textbox
rajoute "End Sub" à la fin
et tout fonctionne.
Merci à MarsuGl
21 nov. 2002 à 22:33
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.