Edit : je viens de m’apercevoir que ce post aurait peut-être mieux sa place dans la sous rubrique Macros et VBA Excel

Bonjour à tous
En partant du code que j'ai récupéré sur votre instructif site :
https://excel.developpez.com/faq/?pa...riptingRuntime
''Comment lister les fichiers contenus dans un répertoire ainsi que dans tous ses sous-répertoires ?''

Etant très médiocre en programmation, je sollicite votre aide pour y apporter quelques modifications.
1 - A la ligne 1, je voudrai y ajouter quelques propriétés des exifs par exemple le nom de l'auteur,le copyright, la dimension etc... Idéalement ça serait bien de pouvoir aller chercher le nom ou le n° dans une autre feuille.
J'ai déjà un code qui fait ça mais je ne sais pas inclure les données dans votre code.

2 - Utile aussi de pouvoir aller chercher le répertoire en ouvrant une fenêtre au lieu d'inscrire le chemin dans une cellule mais ça c'est secondaire

Merci beaucoup

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
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
'https://excel.developpez.com/faq/?page=FichiersDir#ListeFichiersScriptingRuntime
' HautPageComment lister les fichiers contenus dans un répertoire ainsi que dans tous ses sous-répertoires ?
'Cet exemple utilise la récursivité pour boucler sur le dossier spécifié et dans tous ses sous-dossiers.
 
'Le code récupère :
 '    Le nom des fichiers et crée un lien vers ceux-ci.
  '   La date de création.
   '  La date de dernier accès.
    ' La date de la dernière modification.
     'Le nom du répertoire.
 
'La procédure nécessite d'activer la référence "Microsoft Scripting RunTime".
 '    Dans l 'éditeur de macros (Alt+F11):
  '   Menu Outils
   '  Références
    ' Cliquez sur le bouton OK pour valider.
 
'Définissez 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 risuqe d'être très long.
 
Option Explicit
 
Sub TestListeFichiers()
Range("A2:F1000000").ClearContents
Range("J1").ClearContents
    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 = Cells(1, 9) 'dossier à scanner
 
    'Appelle la procédure de recherche des fichiers
    ListeFichiers Dossier
 
    'Ajuste la largeur des colonnes A:E en fonction du contenu des cellules.
    Columns("A:G").AutoFit
    MsgBox "Terminé"
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 SubFolder 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
 
        'Item en colonne A
        Cells(i, 1) = i - 1
        'Inscrit le nom du fichier dans la cellule
        Cells(i, 2) = FileItem.Name
        'Ajoute un lien hypertexte vers le fichier
        ActiveSheet.Hyperlinks.Add Anchor:=Cells(i, 2), _
            Address:=FileItem.ParentFolder & "\" & FileItem.Name
        'Indique la date de création
        Cells(i, 3) = FileItem.DateCreated
        'Indique la date de dernier acces
        Cells(i, 4) = FileItem.DateLastAccessed
        'Indique la date de dernière modification
        Cells(i, 5) = FileItem.DateLastModified
        'Nom du répertoire
        Cells(i, 6) = FileItem.ParentFolder
        Cells(i, 7).Copy Cells(i + 1, 7) 'copie =SIERREUR(STXT(E2;CHERCHE("|";SUBSTITUE(E2;"\";"|";NBCAR(E2)-NBCAR(SUBSTITUE(E2;"\";""))*1))+1;100);"")
 
        i = i + 1
        Cells(1, 10) = i - 2 'compte le nombre de fichiers
    Next FileItem
 
 
    '--- Appel récursif pour lister les fichier dans les sous-répertoires ---.
    For Each SubFolder In SourceFolder.SubFolders
        ListeFichiers SubFolder.Path
    Next SubFolder
 
End Sub