Trois méthodes pour lister les fichiers d'un répertoire, deux avec FileDialog (FileSearch et FileSystemObject) une avec Dir.

Pour trouver le nom du répertoire est utilisé l'exemple de l'aide en ligne
Code : Sélectionner tout - Visualiser dans une fenêtre à part
Set fd = Application.FileDialog(msoFileDialogFilePicker)
Peut-être existe-t-il une méthode plus sioux... mais qui n'aura aucune incidence sur le temps mesuré.

Pour tester les trois procédures, exécuter la procédure "SelectionDuRepertoire"
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
'A déclarer pour la mesure du temps d'exécution
Public Declare Function GetTickCount& Lib "kernel32" ()
 
Sub SelectionDuRepertoire()
Dim fd As FileDialog, NC As Variant, Chemin As String
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    With fd
        If .Show = -1 Then
            For Each NC In .SelectedItems
                Chemin = Left(NC, Len(NC) - InStr(StrReverse(NC), "\"))
            Next
            Else
            MsgBox "Chemin non trouvé"
            Exit Sub
        End If
    End With
    ListerUnRepertoireAvecDir Chemin
    ListerUnRepertoireAvecFileSearch Chemin
    ListerUnRepertoireAvecFso Chemin
End Sub
 
'Public Declare Function GetTickCount& Lib "kernel32" ()
Sub TempsEcoulé(NbF As Integer, duree As Double, NomSub As String)
Dim mn As Integer, ms As Integer, sd As Integer, tps As String
    mn = Int(duree / 1000 / 60)
    sd = Int((duree / 1000) - (mn * 60))
    ms = duree - (sd * 1000) - (mn * 1000 * 60)
    tps = mn & " mn " & sd & " s " & ms & " millisecondes"
    MsgBox "Procédure " & NomSub & vbCr & "Nombre de fichiers du répertoire " & NbF & vbCr & _
    "Temps écoulé : " & tps
End Sub
 
Sub ListerUnRepertoireAvecFileSearch(Chemin As String)
Dim fs As Variant
Dim tablo()
Dim Depart As Double, duree As Double
    Depart = GetTickCount&
    Set fs = Application.FileSearch
    With fs
        .LookIn = Chemin
        .FileType = msoFileTypeExcelWorkbooks
        If .Execute(SortBy:=msoSortByFileName, _
            SortOrder:=msoSortOrderAscending) > 0 Then
            For i = 1 To .FoundFiles.Count
                'Workbooks.Open .FoundFiles(i)
                ReDim Preserve tablo(i)
                tablo(i) = .FoundFiles(i)
            Next i
        End If
    End With
    duree = GetTickCount& - Depart
Dim NomSub As String
    NomSub = "ListerUnRepertoireAvecFileSearch"
    TempsEcoulé UBound(tablo), duree, NomSub
End Sub
 
'Procédure VBA Excel
Sub ListerUnRepertoireAvecDir(Chemin As String)
Dim NomFich As String, tablo()
Dim Depart As Double, duree As Double
    Depart = GetTickCount&
    NomFich = Dir(Chemin & "\", vbNormal)
    Do While NomFich <> ""
        'Workbooks.Open chemin & NomFich
        'DoEvents
        i = i + 1
        ReDim Preserve tablo(i)
        tablo(i) = Chemin & NomFich
        NomFich = Dir()
    Loop
    duree = GetTickCount& - Depart
Dim NomSub As String
    NomSub = "ListerUnRepertoireAvecDir"
    TempsEcoulé UBound(tablo), duree, NomSub
End Sub
 
'Nécessite la validation de la référence "Microsoft Scripting Runtime"
Sub ListerUnRepertoireAvecFso(Chemin As String)
On Error Resume Next
Dim FSO As Scripting.FileSystemObject
    If Err <> 0 Then
        MsgBox "Nécessite la validation de la référence " & vbCr & _
        "Microsoft Scripting Runtime"
        Exit Sub
    End If
Dim Rep As Scripting.Folder
Dim Fich As Scripting.File
Dim tablo()
Dim Depart As Double, duree As Double
    Depart = GetTickCount&
    Set FSO = New Scripting.FileSystemObject
    Set Rep = FSO.GetFolder(Chemin)
 
    For Each Fich In Rep.Files
        If Right(Fich.Name, 4) = ".xls" Then
            'Workbooks.Open chemin & Fich.Name
            'DoEvents
            i = i + 1
            ReDim Preserve tablo(i)
            tablo(i) = Fich.Name
        End If
    Next
    duree = GetTickCount& - Depart
Dim NomSub As String
    NomSub = "ListerUnRepertoireAvecFso"
    TempsEcoulé UBound(tablo), duree, NomSub
End Sub