Macro comptage de fichiers

[Benjy]

Bonjour à tous j'ai un petit soucis avec ce code :

Private Sub CheckBox8_Click()
If CheckBox8 = True Then


[COLOR="red"]Dim FSO As Object, Dossier As String
Dossier = "Z:\protocole\" & Sheets("Sommaire").Cells(28, 2).Value & "\Docs techniques\ENR"
Set FSO = CreateObject("Scripting.FileSystemObject")
NbrFich = FSO.GetFolder(Dossier).Files.Count[/COLOR]


Range("L31").Value = NbrFich
If NbrFich <> 0 Then
Range("I31").Select
ActiveCell.Value = Now
Else
MsgBox ("Vous ne pouvez valider cette action, il faut au minimum une documentation technique !")
CheckBox8 = False
End If
Else
Range("I31").Value = ""
End If
End Sub

J'ai récupérer la partie en rouge sur un autre sujet du forum et je ne la maîtrise donc pas correctement. Le code fonctionne mais ne compte que les fichiers présent dans le dossier cible. J'aimerais qu'il compte également les fichiers des sous dossiers présent dans ce dossier cible. Est- ce possible ? Et si oui comment le réaliser ?

Merci à ceux qui prendront le temps de me répondre.

Cordialement,

Ben

 

[kjin]

Re : Macro comptage de fichiers

Bonjour,

'...
Dossier = "Z:\protocole\" & Sheets("Sommaire").Cells(28, 2).Value & "\Docs techniques\ENR"
Set fso = CreateObject("Scripting.FileSystemObject")
Set fld = fso.GetFolder(Dossier)
NbrFich = fld.Files.Count
For Each sfld In fld.SubFolders
    NbrFich = NbrFich + sfld.Files.Count
Next
'...

A+
kjin

 

[Benjy]

Re : Macro comptage de fichiers

Impeccable Kjin. Par curiosité, peut on généraliser sur plusieurs étages ?

 

[kjin]

Re : Macro comptage de fichiers

Re,
Oui mais dans ce cas, utiliser une fonction récursive

Sub ListeFichiers()
Dim nDirs&, nFiles&, lSize@
Dim Dossier$, Extension$
Dossier = "Z:\protocole\" & Sheets("Sommaire").Cells(28, 2).Value & "\Docs techniques\ENR"
Extension = "*.*" 'à adapter ou utiliser une boite de saisie
lSize = FindFile(Dossier, Extension, nDirs, nFiles)
MsgBox Str(nFiles) & " fichiers trouvés dans " & Str(nDirs) & _
            " répertoires pour un total de " & lSize & " bytes"

End Sub

Function FindFile(ByVal sDir$, sExt$, nDirs&, nFiles&) As Currency
Dim fso As Object, fld As Object, FileName$, sfld As Object
Set fso = CreateObject("Scripting.FileSystemObject")
On Error GoTo Suite
Set fld = fso.GetFolder(sDir)
FileName = Dir(fso.BuildPath(fld.Path, sExt), vbNormal Or vbHidden Or vbSystem Or vbReadOnly)
While Len(FileName) <> 0
    FindFile = FindFile + FileLen(fso.BuildPath(fld.Path, FileName))
    nFiles = nFiles + 1
    FileName = Dir()
    DoEvents
Wend
nDirs = nDirs + 1
If fld.SubFolders.Count > 0 Then
   For Each sfld In fld.SubFolders
      DoEvents
      FindFile = FindFile + FindFile(sfld.Path, sExt, nDirs, nFiles)
   Next
End If
Set fso = Nothing
Set fld = Nothing
Exit Function

Suite:
FileName = ""
Resume Next

End Function

A+
kjin

 

[Benjy]

Re : Macro comptage de fichiers

Intéressant. Merci beaucoup ! Je vais examiner sa parce que de prime abord je ne comprends pas grand chose ^^.

A +