Discussion :

[licpegpon]

Bonjour,

Ce que je souhaite faire :

En supposant l'arborescence suivante (très nombreux sous-dossiers de la forme IDxxxx):

P:\TOTO\
ID1234
ID3254
ID5644
ID6756
ID....

Dans ma procédure, j'affecte le dossier "P:\TOTO" à la variable "MonRepertoire". Les dossiers IDxxxx se situent juste en dessous du dossier TOTO.

La procédure scrute alors tous les sous-dossiers IDxxxx et regarde s'il n'y a pas un fichier du type *.docm. Si un fichier est trouvé, le programme affiche le résultat suivant :

En cellule A1 : IDxxxx et juste à côté (cellule B1) le nom du fichier ayant l'extension docm.
Le programme boucle sur tous les sous-dossiers et affiche quand cela est nécessaire le résultat en sautant une ligne à chaque fois.


Ce que j'ai trouvé sur le net :

J'ai trouvé sur le net une procédure qui réponds à mon besoin (j'y ai apporté quelques modifs) cependant j'aurais besoin de quelques explications car je souhaiterais y apporter quelques modifications. Ci-dessous la procédure :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Option Explicit
Sub ListeFichiersRepert()
Dim Fso  As Object
Dim MonRepertoire As String, f As Object, x As Integer
Dim f1 As Object, f2 As Object
Set Fso = CreateObject("Scripting.FileSystemObject")
MonRepertoire = InputBox("Enter the root directory", "Root directory", "P:\TOTO")
'
x = 1
For Each f In Fso.GetFolder(MonRepertoire).Files
      If f.Name Like "*.docm*" Then
        Cells(x, 1).Value = f.Name
        x = x + 1
     End If
Next f
x = 1
For Each f1 In Fso.GetFolder(MonRepertoire).SubFolders
    Cells(x, 2).Value = f1.Name
    x = x + 1
    For Each f2 In f1.Files
    If f2.Name Like "*.docm*" Then
        Cells(x - 1, 3).Value = f2.Name
        x = x + 1
        End If
    Next f2
    x = x - 1
Next f1
End Sub

Après avoir exécuté la macro voici ce que j'obtiens :




Mes interrogations :

Pourquoi lorsque j'exécute la macro le premier résultat IDxxxx est-il situé en cellule B1 ? Dans la première boucle x étant égal à 1 le résultat devrait être affiché en cellule (1,1) ?
Pourquoi les ID ne sont-ils pas dans l'ordre alphabétique ? Il commence par l'ID5073, suivi de l'ID4621 puis ID4694_1 ... ?
La première boucle semble traiter des fichiers et la seconde des dossiers ?
Pourriez vous m'expliquer ce que fait la ligne de commande : For Each f In Fso.GetFolder(MonRepertoire).Files ?
De façon générale comment fonctionne cette procédure ? Boucles ?

Merci par avance.

Cdlt.
Jérôme.

[mercatog]

Bonjour

La première boucle cherche les fichiers .docm dans le répertoire d'origine et les écrits en colonne A (Tu n'en as pas)
Ensuite la seconde parcourt les sous répertoires et écrit leur noms en colonne B
Enfin une troisième boucle pour chaque sous répertoire écrit les noms des fichiers .docm en colonne C

[licpegpon]

Merci beaucoup.
J ai remarqué qu il affichait l ID du dernier dossier (dernière ligne de la colonne B) avec aucun nom de fichier dans la colonne juste à sa droite....ne serait il pas possible de supprimer cet ID puisque il n'y a pas de fichier doc dans ce dernier dossier ?
Cdlt.
Jérôme

[mercatog]

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Sub ListeFichiersRepert()
Dim Fso As Object, f As Object, f1 As Object, f2 As Object
Dim MonRepertoire As String, Ext As String
Dim x As Long
 
MonRepertoire = InputBox("Enter the root directory", "Root directory", "P:\TOTO")
Ext = "*.docm"
 
Set Fso = CreateObject("Scripting.FileSystemObject")
With Worksheets("feuil1")
    For Each f In Fso.GetFolder(MonRepertoire).Files
        If f.Name Like Ext Then
            x = x + 1
            .Cells(x, 1).Value = f.Name
        End If
    Next f
 
    x = 0
    For Each f1 In Fso.GetFolder(MonRepertoire).SubFolders
        For Each f2 In f1.Files
            If f2.Name Like Ext Then
                x = x + 1
                .Cells(x, 2).Value = f1.Name
                .Cells(x, 3).Value = f2.Name
            End If
        Next f2
    Next f1
End With
Set Fso = Nothing
End Sub

[licpegpon]

Merci Mercatog. Ca fonctionne parfaitement !!

Cdlt.
Jérôme.