Liste des sous dossiers et comptabiliser leurs fichiers

Question

Bonjour,

J'ai créé un petit script me permettant de comptabiliser le nombre de fichiers dans un répertoire et de l'inscrire dans un fichier texte. Voir ci dessous :

Dim Path
Path = "e:\Fic\GAPR"
'MsgBox ShowFolderList(Path),vbmessage,"Fichiers contenus dans le répertoire " & Path

Fichier2 = "e:	emps\TEST1.TXT"

Set MyObject = CreateObject("Scripting.FileSystemObject" )
Set OutFile = MyObject.CreateTextFile(Fichier2,True) 

OutFile.Write "NbrFic: "
OutFile.Write ShowFolderList(Path)

OutFile.Close



Function ShowFolderList(strPath)
Dim fso, Dossiers, fic, fichiers, strListe, nbre
Set fso = CreateObject("Scripting.FileSystemObject")

Set Dossiers = fso.GetFolder(strPath)
Set fic = Dossiers.Files
'pour chaque fichier de mon objet files de mon objet fso...:)
For Each fichiers in fic
'le nom du fichier
nbre = nbre + 1
'strListe = strListe & vbcrlf & vbcrlf & fichiers.Name & " Date (jjmmaa) : " & fichiers.DateLastModified & " Taille (octet) : " & fichiers.Size
Next
ShowFolderList = nbre
'ShowFolderList = strListe
End Function
Set fso = Nothing 


Je rencontre aujourd'hui une nouvelle problématique. Chaque jour, un ou plusieurs sous-répertoires sont créés et les fichiers viennent s'y déposés. Je souhaiterais donc lister uniquement ces nouveaux sous-répertoires (création à la date du jour) et ensuite comptabiliser le nombre de fichiers y figurant et inscrire le résultat dans un fichier texte :
   Rep1: 123 
   Rep2: 10000
   etc...

Ca fait plusieurs jours que je galère et je ne trouve pas de solution pour adapter mon script. Surement n'est-il pas adapter à la base....

Je vous remercie par avance pour vos idées, suggestions et conseils.

Tchou

NHenry · Answer

Bonjour,

En recherchant sur Google, je suis arrivé sur cette page :
http://jc.bellamy.free.fr/download/vbs/filescount.vbs
http://www.vbfrance.com/codes/VBS-MINISCULE-MAJUSCULE-TOUS-DOSSIERS-FICHIERS-AINSI-TOUS_34285.aspx
http://www.vbfrance.com/codes/LISTAGE-RECURSIVE-SOUS-REPERTOIRE_20071.aspx

à toi de voir maintenant.

Mon site

cs_JMO · Answer

Bonjour,

Tu peux t'inspirer de cet exemple.


MsgBox FnShowFolderList("F:", Date, strList)

Function FnShowFolderList(argPath, argDate, strList) 
   Dim objFso, objSubFolderItem, objSubFileItem  
   Set objFso = CreateObject("Scripting.FileSystemObject") 
   
   If Not objFso.FolderExists(argPath) Then Exit Function

   For Each objSubFolderItem In objFso.GetFolder(argPath).SubFolders 
       If DateValue(objSubFolderItem.DateCreated) = argDate Then 
          strList = strList & vbCrLf & objSubFolderItem.Path & _
                    Space(3) & objSubFolderItem.Files.Count
       End If
       FnShowFolderList objSubFolderItem.Path, argDate, strList
   Next 

   Set objFso = Nothing 
   FnShowFolderList = strList    
End Function 



jean-marc

fabefouge · Answer

Bonjour et merci pour vos réponses.
Ton code Jean-Marc répond parfaitement à ma demande, à moi maintenant de diriger le tout dans un fichier.
Merci pour tous 

Tchou

cs_JMO · Answer

Pour l'écriture du fichier



Option Explicit
Const MyFile = "D:\Test.txt" 
Dim objFso, objTextFile
Set objFso = CreateObject("Scripting.FileSystemObject") 
Set objTextFile = objFso.CreateTextFile(MyFile, True)   

Call FnShowFolderList("F:", Date)

objTextFile.Close
Set objTextFile = Nothing
Set objFso = Nothing
'################################################
Function FnShowFolderList(argPath, argDate) 
   Dim objSubFolderItem 
   
   If Not objFso.FolderExists(argPath) Then Exit Function

   For Each objSubFolderItem In objFso.GetFolder(argPath).SubFolders 
       If DateValue(objSubFolderItem.DateCreated) = argDate Then 
          objTextFile.Write objSubFolderItem.Path & Chr(58) & Space(1) &_
                            objSubFolderItem.Files.Count & vbcrlf
       End If
       FnShowFolderList objSubFolderItem.Path, argDate
   Next 
End Function 

 



jean-marc

fabefouge · Answer

Une seule chose à dire : perfect 


Tchou

DevLama · Answer

POur ecrire dans un fichierv tub peux utiliser :

Dim NumFile
NumFile=FreeFile
Open "Nomdufichier.ext" For Append as#NumFile
Print #NumFile,"Hornel LAMA"
Close#NumFile

Liste des sous dossiers et comptabiliser leurs fichiers

6 réponses

Votre réponse

Discussions similaires