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
| Public FL1 As Worksheet
Sub ListerLesFichiersDunRepertoire()
Dim chemin$
Set FL1 = Worksheets("Feuil1") 'instance de feuil1
FL1.Cells.ClearContents 'effacement des cellules
chemin = ChoixDossierFichier
If chemin = "" Then Exit Sub
Application.ScreenUpdating = False
ListerLesFichiersParOrdreAlpha chemin, FL1
DoEvents
FL1.Columns(1).EntireColumn.AutoFit
Application.ScreenUpdating = True
DoEvents
Columns("A:B").EntireColumn.AutoFit
Application.ScreenUpdating = True
Set FL1 = Nothing
End Sub
Function ChoixDossierFichier()
Dim objShell, objFolder, chemin$, Msg$
On Error GoTo Fin
Msg = "Choisir un dossier :"
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(&H0&, Msg, 0, 0)
If objFolder Is Nothing Then Exit Function
chemin = objFolder.ParentFolder.ParseName(objFolder.Title).Path & ""
ChoixDossierFichier = chemin
Fin::
If Err = 91 Then 'erreur si le répertoire "Mes documents a été sélectionné"
If MsgBox("Avez-vous sélectionné le répertoire ""Mes documents"" ?", vbYesNo, "SÉLECTION DE ""MES DOCUMENTS""") = vbYes Then _
ChoixDossierFichier = "C:\Documents and Settings\" & Environ("Username") & "\Mes documents"
On Error GoTo 0
End If
Set objShell = Nothing
Set objFolder = Nothing
End Function
Sub ListerLesFichiersParOrdreAlpha(chemin, FL1)
Dim fs
Set fs = Application.FileSearch
With fs
.LookIn = chemin
.FileType = 4 '1 tous les fichiers, 3 = Doc, 4 = xls,
If .Execute(SortBy:=msoSortByFileName, _
SortOrder:=msoSortOrderAscending) > 0 Then
'Placement du nom des fichiers dans feuil1
For i = 1 To .FoundFiles.Count
'On place le nom des fichiers à partir de la ligne 2 (i + 1)
FL1.Hyperlinks.Add FL1.Cells(i + 1, 2), .FoundFiles(i)
Next i
FL1.Cells(1, 1) = chemin
Else
MsgBox "Aucun fichier n'a été trouvé."
End If
End With
Set fs = Nothing
End Sub |
