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
| Option Explicit
Sub Liste_des_fichiers()
Dim Dossier1 As String
Cells.ClearContents
Cells.Interior.ColorIndex = xlNone
Dossier1 = RecupDossier
Cells(1, 1) = "Nom des fichiers"
Cells(1, 2) = "Chemin des repertoires"
Range(Cells(1, 1), Cells(1, 2)).Interior.ColorIndex = 15
ListeFichiers Dossier1
Columns("A:G").AutoFit
Cells(2, 1).Select
End Sub
Sub ListeFichiers(Repertoire As String)
Dim Fso As Scripting.FileSystemObject
Dim RepertoireSource As Scripting.Folder
Dim SousRepertoire As Scripting.Folder
Dim Fichier As Scripting.File
Dim I As Long
Dim Chaine As String
Dim Extension As String
Set Fso = CreateObject("Scripting.FileSystemObject")
Set RepertoireSource = Fso.GetFolder(Repertoire)
I = Range("A65536").End(xlUp).Row + 1
For Each Fichier In RepertoireSource.Files
Extension = Right(Fichier, 4)
'adapté pour les fichiers avec extensions .xls
If Extension <> ".xls" Then Exit For
Open Fichier For Binary As #1
Chaine = Space(LOF(1))
Get #1, , Chaine
If InStr(Chaine, "Name=""VBAProject""") Then
Cells(I, 1) = Dir(Fichier)
ActiveSheet.Hyperlinks.Add Anchor:=Cells(I, 1), Address:=Fichier.ParentFolder & "\" & Fichier.Name
Cells(I, 2) = RepertoireSource.Path
I = I + 1
End If
Close #1
Next Fichier
For Each SousRepertoire In RepertoireSource.subfolders
ListeFichiers SousRepertoire.Path
Next SousRepertoire
End Sub
Function RecupDossier() As Variant
With Application.FileDialog(4)
.Show
On Error Resume Next
RecupDossier = .SelectedItems(1)
If Err.Number <> 0 Then RecupDossier = False
End With
End Function
Function Fichiers(ByVal Chemin As String) As String()
Dim Tbl() As String
Dim Fichier As String
Dim I As Long
If Right(Chemin, 1) <> "\" Then Chemin = Chemin & "\"
Fichier = Dir(Chemin)
Do While (Len(Fichier) > 0)
I = I + 1
ReDim Preserve Tbl(1 To I)
Tbl(I) = Chemin & Fichier
Fichier = Dir()
Loop
Fichiers = Tbl()
End Function |
