Discussion :

[Ysae68]

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

[mat955]

Bonjour,

Tu nous dis avoir une erreur à la ligne :

Code :

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

Set SourceFolder = Fso.GetFolder(Repertoire)

Si on suit ton code, tu appelles la procédure Lister_fichiers_2 avec l'argument Dossier qui est String, jusque là, rien d'anormal car la méthode GetFolder attend bien un String.

En revanche si on regarde dans la première procédure, tu déclares Dossier en String, et tout de suite après tu lui affectes la valeur de la variable vrtSelectedItem qui je pense est vide à ce moment là.

L'aide Microsoft spécifie bien que la méthode GetFolder renvoie une erreur si le dossier spécifié n'existe pas, ce qui je pense est le cas ici.


A tester :

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
Option Explicit
 
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
 
'**********
 
    Dim fd As FileDialog
 
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    fd.AllowMultiSelect = False 'Empêche de sélectionner plusieurs dossiers
    fd.InitialFileName = "C:\Users\moi\Documents"
    fd.Show
    If fd.SelectedItems.Count < 1 Then End 'Sort de la procédure si l'utilisateur clique sur Annuler dans la boîte de dialogue
    Dossier = fd.SelectedItems(1)
    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 = New 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

[Ysae68]

Bonjour Mat, et merci beaucoup pour ta réponse. Je comprends mieux mon erreur. Comme dit, j'ai essayé d'adapter ce que j'ai trouvé dans la doc Microsoft à ma macro déjà existante. Et c'est la seule façon que j'ai trouvé pour lier ma valeur Dossier au dossier sélectionné via la boîte de dialogue.

Par contre, je ne peux pas tester le code que tu as mis, j'ai un problème dès le départ : je ne peux pas sélectionner de dossier dans la boîte de dialogue, je ne peux que les ouvrir. Et quand j'arrive dans un dossier sans sous dossier à ouvrir, si je clique "Ouvrir" ou appuie sur Entrée, j'ai une erreur comme quoi les données n'ont pas pu être trouvées.

[mat955]

Bonjour,

Mea culpa, j'ai écrit trop vite et je t'ai mis une boîte de dialogue pour sélectionner un fichier au lieu d'un dossier !

Il faut corriger la ligne 19 par :

Code :

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

Set fd = Application.FileDialog(msoFileDialogFolderPicker)

[Ysae68]

Ah oui effectivement, un tout petit oubli ! Mais ça marche maintenant, merci beaucoup pour ton aide !