Bonjour à tous,

J'ai une macro qui me permet de lister dans un fichier Excel les fichiers contenus dans un dossier et ses sous-dossiers. La sélection du dossier à lister se fait juste via un Dim Dossier As String et Dossier = "H:\DATA\Test". Seulement voila, j'aimerais éviter d'avoir à chaque fois renseigner dans le code le lien vers le dossier, et que la sélection du dossier se fasse via une boîte de dialogue. Donc, je me renseigne, je trouve la propriété msoFileDialogFolderPicker, j'essaye d'adapter à ma macro existante... et ça ne marche pas. Voila ce que j'ai pour le moment :

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
95
96
97
98
99
100
101
102
103
104
105
106
107
Sub Lister_Fichiers_1()
 
'Liste tous les fichiers d'un dossier avec ses sous dossiers et affiche les noms des fichiers dans un classeur Excel
'Nécessite 2 macros
 
Dim Dossier As String
 
Dim vrtSelectedItem As Variant
 
'Définit le répertoire pour débuter la recherche de fichiers
Dossier = vrtSelectedItem
 
'**********
 
'Declare a variable as a FileDialog object
 Dim fd As FileDialog
 
 'Create a FileDialog object as a Folder Picker dialog box.
 Set fd = Application.FileDialog(msoFileDialogFolderPicker)
 
 'Declare a variable to contain the path
 'of each selected item. Even though the path is aString,
 'the variable must be a Variant because For Each...Next
 'routines only work with Variants and Objects.
 
 'Use a With...End With block to reference the FileDialog object.
 With fd
 
 'Set the initial path to the C:\ drive.
 .InitialFileName = "C:\Users\moi\Documents"
 
 'Use the Show method to display the File Picker dialog box and return the user's action.
 'If the user presses the button...
 If .Show = -1 Then
 
 'Step through each string in the FileDialogSelectedItems collection.
 For Each vrtSelectedItem In .SelectedItems
 
 Next vrtSelectedItem
 'If the user presses Cancel...
 Else
 End If
 End With
 
 'Set the object variable to Nothing.
 Set fd = Nothing
 
'**********
 
'Appelle la procédure de recherche des fichiers
Lister_Fichiers_2 Dossier
 
'Ajuste la largeur des colonnes A:E en fonction du contenu des cellules.
Columns("A:E").AutoFit
 
'Enlève les extensions de fichiers
Columns("A").Select
    Selection.Replace What:=".docx", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=True, _
        ReplaceFormat:=True
 
Columns("A").Select
    Selection.Replace What:=".doc", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=True, _
        ReplaceFormat:=True
 
End Sub
 
Sub Lister_Fichiers_2(Repertoire As String)
 
'Nécessite d'activer la référence "Microsoft Scripting Runtime"
 
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
 
'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, 5) = FileItem.ParentFolder
 
i = i + 1
 
Next FileItem
 
'Appel récursif pour lister les fichier dans les sous-répertoires
    For Each SubFolder In SourceFolder.SubFolders
        Lister_Fichiers_2 SubFolder.Path
    Next SubFolder
 
End Sub
La partie entre ********** vient directement de la documentation Microsoft. Pas sûre d'avoir besoin de tout, mais dans le doute, j'ai laissé... Et sinon, j'ai une erreur à la ligne 81, sur Set SourceFolder = Fso.GetFolder(Repertoire) "appel de procédure non valide ou argument".

Merci d'avance pour votre aide