Compter les répertoires…

[Clo]

Bonjour à toutes / tous !

¤ Sur le Forum anglais, l'utilisateur Raymond a rappellé une astuce pour compter et afficher en message le nombre de sous-répertoires dans le répertoire en cours, grâce au petit script “Visual Basic” ci-dessous, adapté en Français :

Code: Select all

Set objArgs = WScript.Arguments 
Set fso = CreateObject("Scripting.FileSystemObject") 

For I = 0 to objArgs.Count - 1 
If fso.folderExists( objArgs(I) ) then 
Set folder = fso.GetFolder( objArgs(I) ) 
Count = MsgBox("Nombre de s-rép. dans répertoire en cours : " & folder.SubFolders.count, 0, """" & folder & """") 'count folders 
'Count = MsgBox("Folders: " & folder.Files.count, 0, """" & folder & """") 'count files 
Else 
'nothing 
End If 
Next 
'Original by W!ke76(http://www.eforum.de/showthread.php?s=&threadid=1356)

- Copiez / collez ce code dans un nouveau fichier "Texte", que vous pouvez enregistrer sous ComptRep.vbs par exemple.
- Ajouter simplement ce fichier au menu "Utilisateur", avec le paramètre "%P", y compris les guillemets !
- On peut aussi installer un bouton dans la barre avec Glisser & Déplacer + MAJ, et ajouter le même paramètre "%P" dans le champ ad-hoc du dialogue de la barre des boutons.
¤ Et le même, mais récursif (avec les sous-sous…répertoires) :

Code: Select all

Set objArgs = WScript.Arguments 
Set fso = CreateObject("Scripting.FileSystemObject") 
SubDirCount = 0 

For I = 0 to objArgs.Count - 1 
   If fso.folderExists( objArgs(I) ) then 
      Set folder = fso.GetFolder(objArgs(I)) 
      LastPart = Mid(folder, InStrRev(folder, "\") + 1) 
      RecurseFolder folder, fso 
      Call MsgBox("Le nombre de s.-rép. dans le répertoire sélectionné '" + LastPart + "' est de: " & SubDirCount, 64, folder) 
   End If 
Next 

Sub RecurseFolder(sPath, fso) 
   Dim fFolder, fSubFolders, fSubFolder 

   Set fFolder = fso.GetFolder(sPath) 
   Set fSubFolders = fFolder.SubFolders 

    'Now recurse for each subfolder in the sPath folder... 
    For Each fSubFolder In fSubFolders 
        '*** Call self to recurse down folders 
        Call RecurseFolder(sPath & "\" & fSubFolder.name, fso) 
        SubDirCount = SubDirCount + 1 
    Next 
End Sub 
'Original by W!ke76(http://www.eforum.de/showthread.php?s=&threadid=1356)

Comme Raymond le dit lui-même plus loin dans la même rubrique, l'idéal serait d'obtenir ce(s) compte(s) affiché(s) en barre d'état. Un petit module serait le bienvenu…

À vos claviers !
- Il faudrait tenir compte d'un petit problème avec le réseau…

Bien cordialement,
Claude
Clo

[Vansumsen]

Bonsoir à tous,
Ayant eu quelques problèmes avec des répertoires (en NTFS) exigants une permission de Windows, je me suis permis d'adapter le «CountFolders» ou «Compteur de répertoires et sous-répertoires» version récursive...
En voici le code :

Code: Select all

Set objArgs = WScript.Arguments 
Set fso = CreateObject("Scripting.FileSystemObject") 
SubDirCount = 0 
CountRefused = 0 
Refused = ""

For I = 0 to objArgs.Count - 1 
   If fso.folderExists( objArgs(I) ) then 
      Set folder = fso.GetFolder(objArgs(I)) 
      LastPart = Mid(folder, InStrRev(folder, "\") + 1) 
      RecurseFolder folder, fso 
      If CountRefused <> 0 then
         Refused = Chr(10) & Chr(13) & "Plus " & CountRefused & " dont l'accès est refusé par Windows !"
      else
         Refused = Chr(10) + Chr(13) + "Aucun accès n'a été refusé par Windows"
      end if
      If LastPart <> "" then
         Call MsgBox("Le nombre de sous-répertoires dans le répertoire actif '" + LastPart + "' est de: " & SubDirCount & Refused , 64, folder)
      else
         Call MsgBox("Le nombre répertoires et de sous-répertoire du disque actif est de: " & SubDirCount & Refused , 64, folder)
      End If
   End If 
Next 

Sub RecurseFolder(sPath, fso) 
   Dim fFolder, fSubFolders, fSubFolder 
   Set fFolder = fso.GetFolder(sPath)
   Set fSubFolders = fFolder.SubFolders 
    On Error Resume Next
    'Now recurse for each subfolder in the sPath folder... 
    For Each fSubFolder In fSubFolders 
        '*** Call self to recurse down folders 
        Call RecurseFolder(sPath & "\" & fSubFolder.name, fso)
	If Err.Number <> 0 Then 
		CountRefused = CountRefused + 1
	Else
		SubDirCount = SubDirCount + 1 
	End If
    Next 
End Sub 

'Original by W!ke76(http://www.eforum.de/showthread.php?s=&threadid=1356)
'Patched by «Le ouistiti»

Pour l'essayer :
- Copiez / collez ce code dans un nouveau fichier "Texte", que vous pouvez enregistrer sous ComptRep.vbs par exemple (extension vbs obligatoire).
- Ajouter simplement ce fichier au menu "Utilisateur" de TC, avec le paramètre "%P", y compris les guillemets !
- On peut aussi installer un bouton dans la barre avec Glisser & Déplacer + MAJ, et ajouter le même paramètre "%P" dans le champ ad-hoc du dialogue de la barre des boutons.

Amicalement
Paul

[Clo]

2Vansumsen
Merci Paul!
- Ça marche «au petit poil» !

 Amicalement,
Claude
Clo