XL 2010 Compter les fichiers dans rep et sous rep par type

[jeanmi]

Bonjour à tous et bonne année,

J’ai récupérer une macro de #camarchepas : https://www.excel-downloads.com/threads/macro-pour-compter-des-fichiers-pdf.221517/ (post #3) que j’ai essayé d’adapter à ce que je cherche à faire, compter tous les fichiers qui sont dans le rep et sous rep et sous/sous rep et les affecter à des variables.

Le problème est que cela ne compte pas tous mes fichiers.

Voici l’architecture de mon répertoire à comptabiliser :

Répertoire A (le plus haut)

Sous répertoire B

Plusieurs Sous/sous répertoire de B1 à Bx avec des fichiers PDF dans chacun (fichiers pas comptabilisés)

Sous répertoire C avec des fichiers docm (fichiers comptabilisés)

Sour répertoire E de plusieurs types (fichiers comptabilisés)

Des fichiers dans le répertoire A, un fichier xlsm et un fichier zip (fichiers nom comptabilisés)

Pouvais vous m’aider à adapter cette macro.

Voici le code que j'ai essayé d'adapter :

Sub test_v()

Dim FileSystemObject As Object, SsRep As Object, F As Object
Dim Compteur As Long
Dim Chemin As String, E_pdf As String

Set FileSystemObject = CreateObject("Scripting.FileSystemObject")

'le chemin
Chemin = "D:\A-essai"

For i = 1 To 5

If i = 1 Then Extension = ".pdf"
If i = 2 Then Extension = ".docm"
If i = 3 Then Extension = ".xlsx"
If i = 4 Then Extension = ".png"
If i = 5 Then Extension = ".zip"

For Each SsRep In FileSystemObject.GetFolder(Chemin).SubFolders

    For Each F In SsRep.Files
    If InStr(1, F.Name, Extension) > 0 Then Compteur = Compteur + 1
    Next F
    
Next SsRep
      
    If i = 1 Then nb_pdf = Compteur: MsgBox "nombre de fichiers pdf : " & Compteur
    If i = 2 Then nb_docm = Compteur: MsgBox "nombre de fichiers docm : " & Compteur
    If i = 3 Then nb_xlsx = Compteur: MsgBox "nombre de fichiers xlsx : " & Compteur
    If i = 4 Then nb_png = Compteur: MsgBox "nombre de fichiers png : " & Compteur
    If i = 5 Then nb_zip = Compteur: MsgBox "nombre de fichiers zip : " & Compteur
 
  Compteur = 0
 
Next i

nb_total = nb_pdf + nb_docm + nb_xlsx + nb_png + nb_zip
 
MsgBox "Nombre total de fichiers  : " & nb_total


End Sub

Merci d’avance pour l'aide

Cordialement

 

[Hasco]

Re,

Toujours aussi flou.

Si oDic("pdf") = Résultat de la macro qui a créée les pdf alors c'est parfait, sinon ça coince.
Si oDic("doc") = Résultat de la macro qui a créée les doc alors c'est parfait, sinon ça coince.

De toute façon si vos macros qui créent les documents ne vérifient pas leur résultat (gestion d'erreur autre que 'Resume next'), alors elles sont mal faites.

Sans plus d'éléments concrets, je vais passer mon chemin.

Bonne soirée

 

[jeanmi]

Re,

Toujours aussi flou.

Si oDic("pdf") = Résultat de la macro qui a créée les pdf alors c'est parfait, sinon ça coince.
Si oDic("doc") = Résultat de la macro qui a créée les doc alors c'est parfait, sinon ça coince.

De toute façon si vos macros qui créent les documents ne vérifient pas leur résultat (gestion d'erreur autre que 'Resume next'), alors elles sont mal faites.

Sans plus d'éléments concrets, je vais passer mon chemin.

Bonne soirée

re
il me semblais que ma réponse était claire, pour moi.

Pour la variable qui se nome A je souhaite avoir le nombre de fichier PDF, pour la variable B le nombre des fichiers doc et ainsi de suite...

si pas possible je continuerais à les compter manuellement, en interrogent pour les répertoires un à un.

Dans tous les cas merci pour l'aide.

cordialement

 

[fanch55]

d’après ce que j'ai vu,
pour @Hasco

A=odic("pdf")​

B= odic("doc")​

etc ...​

pour moi :

A=F("PDF")​

B=F("DOC")​

etc ..​

 

[chris]

RE

Et si déjà tu répondais concernant PowerQuery... pour cette fois et le sprochaines on serait fixé...

 

[patricktoulon]

bonsoir
tout le monde sait que scriptingfilesystemobject en lecture complète dossier/sousdossier va mettre des plombes
l'utilisation de dir dans une fonction récursive sera plus indiqué pour la rapidité
ensuite la structure même de la macro ne va pas dans les sous dossiers
et cette façon de coder des IF pour le choix de l'extension ça na pas de sens
en gros tu n'y est pas du tout
et ce test instr n'est pas suffisamment précis pour éviter les bévues
j'aurais fait un truc du genre

If InStr(len(f.name)-5, F.Name, Extension) > 0 Then Compteur = Compteur + 1

mais bon c'est loin d’être le plus grave

et pour finir j'ai du mal a percevoir l'utilité de savoir combien il y a de pdf ou de png ou je ne sais quoi d'autre dans un dossier

voilà une vrai fonction dir en récursif qui va bien lister dossiers et sous dossiers certainement plus vite que filesystemobject
vous reste a intégrer le code pour faire vos tableau d'extensions mais là je m'adresse a ceux qui voudront bien t'aider et qui en ont la compétence

'******************************************
'fonction Dir en recursif pour lister les fichiers  dans dossier et sous dossiers
'auteur :patricktoulon
'date :03/07/2018
'avec un object collection pour relancer la récursivité
'****************************************************************
 Function liste_mes_Fichiers(path As String, Optional T As Variant = Null, Optional ExT As Variant = 0, Optional a As Long = 0)
    Dim itemVU As String, folder As Variant, dirCollection As Collection, i As Long
    Set dirCollection = New Collection
    If IsNull(T) Then T = Array()
    crit = vbDirectory Or vbHidden Or vbNormal Or vbArchive Or vbReadOnly Or vbSystem Or vbVolume
    On Error GoTo passe
    itemVU = Dir(path, crit)
    'Debug.Print IsArray(ExT)
    'Explore le dossier courant (path)
    Do Until itemVU = vbNullString
        'si ce n'est pas un dossier on ajoute le fichier a la liste
        If Left(itemVU, 1) <> "." And Not path Like "*RECYCLE*" Then
            If (GetAttr(path & itemVU) And vbDirectory) <> vbDirectory Then
                'Debug.Print Right(itemVU, 4)
                If IsArray(ExT) Then
                    For i = 0 To UBound(ExT)
                        If itemVU Like "*" & ExT(i) Then
                            ReDim Preserve T(0 To a): T(a) = path & itemVU: a = a + 1:
                        End If
                    Next
                Else
                    ReDim Preserve T(0 To a): T(a) = path & itemVU: a = a + 1:
                End If
            End If
        End If
        'ajout des dossiers enfant direct de la racine a la collection
        If Left(itemVU, 1) <> "." And (GetAttr(path & itemVU) And vbDirectory) = vbDirectory Then
            dirCollection.Add itemVU
        End If
        itemVU = Dir()
    Loop
passe:
Err.Clear
    'Exploration des subdossier inscrit dans la collection
    For Each folder In dirCollection
        'Debug.Print "---SubDirectory: " & directory & "---"
        liste_mes_Fichiers path & folder & "\", T, ExT, a
    Next folder
    liste_mes_Fichiers = T
End Function

Sub Test()
    tabl = liste_mes_Fichiers("I:\", ExT:=Array(".mp4", ".avi", ".ts", ".flv"))  ' EXTENTION DEMANDE
    Cells(1, 1).Resize(UBound(tabl), 1) = Application.Transpose(tabl)
End Sub

 

[jeanmi]

RE

Et si déjà tu répondais concernant PowerQuery... pour cette fois et le sprochaines on serait fixé...

re,
toutes mes excuse, j'ai regardé mais j'ai rien compris comment faire.
ce que je souhaite c'est ajouter une macro à mon programme pour réaliser la fonction souhaitée automatiquement.
c'est possible avec PowerOuery de l'incorporer dans mes macros ?

cordialement

 

[jeanmi]

d’après ce que j'ai vu,
pour @Hasco

A=odic("pdf")​

B= odic("doc")​

etc ...​

pour moi :

A=F("PDF")​

B=F("DOC")​

etc ..​

bonjour @fanch55

Merci pour la réponse, je vais essayer de tester tous ça.

j'utilise les macros, avec vos aides, mais je suis loin de les comprendre, et là sur ce sujet, beaucoup de réponses, c'est formidable, mais pour un non connaisseur, j'ai l'impression d'être complètement perdu dans les méandres de tous ces codes.

Merci aussi à @patricktoulon pour le code que je vais aussi essayé de faire fonctionner chez moi.

Merci à tous pour vos différentes propositions, je vais travailler pour pouvoir faire ou pas en fonction des mes possibilités de compréhension sur vos propositions.

Cordialement