Comptage de fichiers récursif

Version imprimable

Bonjour,

Je cherche à compter les fichiers .Txt de plusieurs répertoires et écrire les résultats dans une feuille.
J'ai lu la FAQ comptage de fichiers mais je n'arrive pas à mes fins.
J'essaie d'intégrer le comptage dans la macro suivante sous Excel 2016

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Sub TestDate()
    Dim DernLigne As Long
    DernLigne = Range("A" & Rows.Count).End(xlUp).Row                 ' Test Derniere ligne Feuille
    Dim i As Integer
    Dim F
    Dim oFSO, oFld
    Dim TextToDisplay
    Dim Compteur As Integer                                           ' Création compteur
        Set oFSO = CreateObject("Scripting.FileSystemObject")
        For i = 3 To DernLigne                                        ' Demarrage Boucle récursive
            TextToDisplay = ""
             Compteur = 0                                             ' Remise à zéro du compteur de fichiers
            F = Cells(i, "G").Value                                   ' Contient l’adresse Hypertexte des dossiers à traiter
            Err.Clear
            On Error Resume Next
                Set oFld = oFSO.GetFolder(F)
                TextToDisplay = oFld.DateCreated                      ' Lecture de la date.
            Compteur =                             ' Ici j'aimerai La valeur du Compteur de *.Txt
                Cells(i, "L") = TextToDisplay                         ' Ecriture de la date récupérée.
            Cells(i, "M") = Compteur                                  ' Ecriture du Compteur dans la cellule de mon choix
                Err.Clear
        Next i
End Sub

Par avance merci à qui pourra me donner un coup de main.

23/03/2017, 12h11
kiki29

Salut, c'est la plus rapide largement devant FSO et DIR mais aussi complexe ( via les APIs ), à adapter à ton contexte : Liste des fichiers d'un dossier : Win 32/64 Bits
23/03/2017, 12h26
jimmy17

Houlala! KIKI29

Merci à toi mais,
J'ai téléchargé le fichier, déballé, vu le Vba, mais impossible pour moi de l'intégrer à ma macro.
Je suis largement débutant. L'adaptation est par trop difficile pour moi.
Je pense qu'une ligne Fso pourrait être utilisée, mais je n'en ai pas trouvé la syntaxe ni la déclaration.

Un début de soluce : avec oFld.Files

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
Sub TestDate()
    Dim DernLigne As Long
    DernLigne = Range("A" & Rows.Count).End(xlUp).Row                 ' Test Derniere ligne Feuille
    Dim i As Integer
    Dim F
    Dim oFS, oFld, oFc
 
    Dim TextToDisplay
    Dim Compteur As Integer                                           ' Création compteur
        Set oFSO = CreateObject("Scripting.FileSystemObject")
        For i = 3 To DernLigne                                        ' Demarrage Boucle récursive
            TextToDisplay = ""
            F = Cells(i, "G").Value                                   ' Contient l’adresse Hypertexte des dossiers à traiter
            Err.Clear
            On Error Resume Next
 
                Set oFld = oFSO.GetFolder(F)
                Set oFc = oFld.Files
 
                TextToDisplay = oFld.DateCreated
                Compteur = 0
 
                For Each afile In oFc
                     If UCase(Right(afile.Name, 3)) = "TXT" Then
                       Compteur = Compteur + 1
                   End If
                Next
 
                Cells(i, "L") = TextToDisplay                         ' Ecriture de la date récupérée.
                Cells(i, "M") = Compteur                                  ' Ecriture du Compteur dans la cellule de mon choix
                Err.Clear
        Next i
End Sub

8-)

Bonjour et Merci de votre réponse.
J'ai intégré les éléments, mais j'ai une erreur de compilation (Projet ou Bib introuvable sur :
For Each afile In oFc
J'ai modifié en :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
Sub TestDate()
    Dim DernLigne As Long
    DernLigne = Range("a" & Rows.Count).End(xlUp).Row
    Dim i As Integer
    Dim F
    Dim Afile As TextBox
    Dim oFSO, oFld, oFc
    Dim TextToDisplay
    Dim Compteur As Integer
        Set oFSO = CreateObject("Scripting.FileSystemObject")
       'For i = 3 To DernLigne
        For i = 3 To 10
            TextToDisplay = ""
            F = Cells(i, "g").Value
            Err.Clear
            On Error Resume Next
                Set oFld = oFSO.GetFolder(F)
                Set oFc = oFld.Files
                TextToDisplay = oFld.DateCreated
                Compteur = 0
                For Each Afile In oFc
                     If Afile.GetExtensionName(F) = "TXT" Then
                        Compteur = Compteur + 1
                        MsgBox (Compteur)
                End If
                Next
                Cells(i, "l") = TextToDisplay
                Cells(i, "M") = Compteur
                Err.Clear
        Next i
End Sub

Je récupere 1 alors qu'il y a plusieurs documents Txt
Une idée?

Salut.

Perso, je n'intégrerais pas le comptage des fichiers dans la macro. Règle de base: Une et une seule responsabilité par fonction. Ca facilite les tests et ça permet, surtout, d'engranger des pièces de légo réutilisables qu'il te suffira d'assembler.

Voici une fonction qui retourne le nombre de fichiers correspondant à une extension

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Function CountOfFiles(Extension As String, FolderName As String, Optional LookAtSubFolders As Boolean = True) As Long
  Dim CountOf As Long
  Dim sf As Object
  Dim f As Object
  Dim fso As Object
  Dim file As Object
 
  Set fso = CreateObject("scripting.FileSystemObject")
  Set f = fso.GetFolder(FolderName)
  For Each file In f.files
    If InStr(1, file.Name, ".") <> 0 Then
      If UCase(Right(file.Name, InStr(1, StrReverse(file.Name), ".") - 1)) = UCase(Extension) Then CountOf = CountOf + 1
    End If
  Next file
  If LookAtSubFolders Then
    For Each sf In f.SubFolders
      CountOf = CountOf + CountOfFiles(Extension, sf.Path, LookAtSubFolders)
    Next sf
  End If
  CountOfFiles = CountOf
End Function

23/03/2017, 15h31
jimmy17

Merci Beaucoup.
Je comprends 1 fonction à la fois.
Je vais créer une macro, tester ça et je reviens poster plus tard.
Il va me falloir un peu de temps.:aie:
25/03/2017, 22h54
jimmy17

Aie je n'ai pas réussi

Bonsoir,

J'ai vainement essayé d'intégrer une des deux solutions proposées, mais j'ai toujours des erreurs de compilation.
Je n'ai pas le bagage suffisant pour intégrer et déclencher une fonction (Pierre Fauconnier), et la solution de Argoet me renvoie une erreur sur Afile.
Encore un peu plus Svp ?
26/03/2017, 11h04
Promethee25

Citation:

Envoyé par kiki29

Salut, c'est la plus rapide largement devant FSO et DIR mais aussi complexe ( via les APIs ), à adapter à ton contexte : Liste des fichiers d'un dossier : Win 32/64 Bits

Bonjour kiki29,

+1 mérité pour les perfs impressionnantes de ton code (quelques secondes pour 34000 fichiers dans une arborescence "aléatoire").

Par contre, il est vrai que pour quelqu'un comme quoi qui connaît plutôt bien Excel et pas trop mal le VBA pour Excel mais pas vraiment les API Windows, ça aurait été plus facile à comprendre et réexploiter avec un code un peu plus commenté... :roll:

Mais c'est extrêmement intéressant car j'utilise habituellement Dir (plus performant que FSO) mais dans certaines de mes macros, j'ai introduit certaines limitations afin de maintenir une vitesse suffisante (Dir parfois trop lent sur des arborescences de fichiers sur serveur en réseau) et ce code pourrait me permettre de les débrider, si tant est que j'arrive à le comprendre.

Resolu

Bonjour,
Je viens de réussir une macro qui compte le nombre de fichiers (Mp3) de mes dossiers.
Comme il y à en fait 2 fichiers système et un fichier image, je déduit 3 du nombre trouvé et mon opération est bien bonne.
Même si la solution n'est pas orthodoxe (elle ne compte pas les extensions, mais les trouve par une déduction) elle me satisfait.
Je vous remercie du temps passé et des exemples que j'ai pu adapter à ma sauce.
Je joins le code à toutes fins utiles :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 Sub Nbfic() Dim DernLigne As Long DernLigne = Range("a" & Rows.Count).End(xlUp).Row Dim NombreFichiers Dim i As Integer Dim Dossier As String Dim oFSO As Object 'For i = 3 To DernLigne For i = 3 To 10 Dossier = Cells(i, "G").Value Err.Clear On Error Resume Next Set oFSO = CreateObject("Scripting.FileSystemObject") NombreFichiers = oFSO.GetFolder(Dossier).Files.Count Cells(i, "M") = NombreFichiers - 3 Set oFSO = Nothing Err.Clear NombreFichiers = 0 Next i End Sub
Encore Merci:lol::D