Discussion :

[sharivary]

Bonjour,
Je suis niveau débutant en VBA et grâce à ce forum ainsiqu'à vos contributions, j'ai commencé à réaliser une plateforme de documents portant sur des fichiers éparpillés dans plusieurs dossiers et sous dossiers.

Afin que celle-ci se mette à jour le plus simplement possible, j'ai placé sous chaque répertoire un fichier excel (se nommant SYSTEME_Outil_MAJ_auto *** 1 ou 2 ou 3, etc ...) qui, à l'ouverture, liste automatiquement les fichiers présents sous le répertoire et sauvegarde.

Un autre fichier excel (nommé Outil_MAJ) est chargé d'ouvrir tout les fichiers excel puis de les fermer les un à la suite des autres afin de les lancer, d'exécuter leurs macros, de sauvegarder la mise à jour puis de les fermer.

Seulement, je souhaiterais que le fichier excel SYSTEME_Outil_MAJ_auto *** ne tienne pas compte de lui même dans le listage des fichiers présent sous répertoire.

Code :

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
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
 
Private Sub Workbook_Open()
'Lance les macro à l'ouverture et sauvegarde automatiquement
 
Call MAJ
'Enregistre les modifications du fichier contenant la macro
ThisWorkbook.Save
 
End Sub
Sub MAJ()
        'Lance la macro Clear puis TestListeFichiers
 
Call Clear
Call TestListeFichiers
Call ListeFichiers(ActiveWorkbook.Path)
End Sub
Sub Clear()
    'Efface tout les précédents enregistrements
 
ActiveSheet.Shapes.SelectAll
Selection.Delete
ActiveSheet.Cells.Clear
End Sub
 
Sub TestListeFichiers()
    Dim Dossier As String
 
    'Définit le répertoire pour débuter la recherche de fichiers.
    '(Attention à ne pas indiquer un répertoire qu contient trop de sous-dossiers ou de
    'fichiers, sinon le temps de traitement va être très long).
    Dossier = ActiveWorkbook.Path
 
 
End Sub
 
Sub ListeFichiers(Repertoire As String)
    '
    'Nécessite d'activer la référence "Microsoft Scripting RunTime"
        'Dans l'éditeur de macros (Alt+F11):
        'Menu Outils
        'Références
        'Cochez la ligne "Microsoft Scripting RunTime".
        'Cliquez sur le bouton OK pour valider.
 
    Dim Fso As Scripting.FileSystemObject
    Dim SourceFolder As Scripting.folder
    Dim FileItem As Scripting.File
    Dim i As Long
 
    Set Fso = CreateObject("Scripting.FileSystemObject")
    Set SourceFolder = Fso.GetFolder(Repertoire)
 
    'Récupère le numéro de la dernière ligne vide dans la colonne A.
    i = Range("A65536").End(xlUp).Row + 1
 
    'Boucle sur tous les fichiers du répertoire
    For Each FileItem In SourceFolder.Files
        'Inscrit le nom du fichier dans la cellule
        Cells(i, 1) = FileItem.Name
        'Ajoute un lien hypertexte vers le fichier
        ActiveSheet.Hyperlinks.Add Anchor:=Cells(i, 1), _
            Address:=FileItem.ParentFolder & "\" & FileItem.Name
 
                'Nom du répertoire
        Cells(i, 2) = FileItem.ParentFolder
 
        i = i + 1
      Next FileItem
 
End Sub

J'ai pas mal cherché par moi même depuis 4-5 jours mais mon niveau de compétence m'a freiné...

D'avance merci pour vos efforts!

Le fichier est en pièce jointe.

[Philippe Tulliez]

Bonjour,
J'ai parcouru en vitesse le code que tu as affiché.
En ligne 50, tu as cette ligne

Code :

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

Cells(i, 1) = FileItem.Name

Je ferais précéder cette ligne par un IF ou un Select Case pour empécher l'exécution du code d'écriture si le nom du classeur est égal à SYSTEME_Outil_MAJ_auto suivi du suffixe .xls ou .xlsm.
Pour connaître le nom du classeur c'est ThisWorkbook.Name
Le code avec IF serait donc

Code :

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

IF FileItem.Name = ThisWorkbook.Name then

[defluc]

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
31
32
33
34
Sub ListeFichiers(Repertoire As String)
    '
    'Nécessite d'activer la référence "Microsoft Scripting RunTime"
        'Dans l'éditeur de macros (Alt+F11):
        'Menu Outils
        'Références
        'Cochez la ligne "Microsoft Scripting RunTime".
        'Cliquez sur le bouton OK pour valider.
 
    Dim Fso As Scripting.FileSystemObject
    Dim SourceFolder As Scripting.folder
    Dim FileItem As Scripting.File
    Dim i As Long
    Set Fso = CreateObject("Scripting.FileSystemObject")
    Set SourceFolder = Fso.GetFolder(Repertoire)
    'Récupère le numéro de la dernière ligne vide dans la colonne A.
    i = Range("A65536").End(xlUp).Row + 1
 
    'Boucle sur tous les fichiers du répertoire
    For Each FileItem In SourceFolder.Files
       If FileItem.Name <> ThisWorkbook.Name Then
        'Inscrit le nom du fichier dans la cellule
          Cells(i, 1) = FileItem.Name
        'Ajoute un lien hypertexte vers le fichier
          ActiveSheet.Hyperlinks.Add Anchor:=Cells(i, 1), _
            Address:=FileItem.ParentFolder & "\" & FileItem.Name
 
                'Nom du répertoire
          Cells(i, 2) = FileItem.ParentFolder
        End If
        i = i + 1
      Next FileItem
 
End Sub

[sharivary]

Merci à vous deux pour vos réponses si rapides!