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
108
109
110
111
112
113
114
115
116
117
118
| Private Sub UserForm_Initialize()
Call efface_contrats
End Sub
Sub ListeFichiers(Repertoire As String)
Dim ligne As Integer
ligne = 1
Dim i As Byte
'Nécessite d'activer la référence "Microsoft Scripting RunTime"
'Dans l'éditeur de macros (Alt+F11):
'Menu Outils
'Références
'Cochez la ie "Microsoft Scripting RunTime".
'Cliquez sur le bouton OK pour valider.
Dim Fso As Scripting.FileSystemObject
Dim SourceFolder As Scripting.Folder
Dim SubFolder As Scripting.Folder
Dim classeur As Scripting.File
Set Fso = CreateObject("Scripting.FileSystemObject")
Set SourceFolder = Fso.GetFolder(Repertoire)
Dim classOK As Boolean
'Boucle sur tous les fichiers du répertoire
For Each classeur In SourceFolder.Files
classOK = False
For i = 1 To 10
If USF_saisie.Controls("clé_" & i).Value = "" Then Exit For
If InStr(classeur.Name, USF_saisie.Controls("clé_" & i)) > 0 Then
classOK = True
Exit For
End If
Next i
If classOK = True Then
ligne = ligne + 1
With classeur
'Nom du répertoire
Cells(ligne, 1) = .ShortPath
'nom du fichier
Cells(ligne, 2) = .Name
'Ajoute un lien hypertexte vers le fichier
'ActiveSheet.Hyperlinks.Add Anchor:=Cells(ligne, 3), _
Address:=.ParentFolder & "\" & .Name
'Taille du Classeur
Cells(ligne, 3) = .Size
'Type du classeur
Cells(ligne, 4) = .Type
'Date de création
Cells(ligne, 5) = Format(.DateCreated, "dd:mm:yy"" à ""hh:mm")
'Date de dernière modification
Cells(ligne, 6) = Format(.DateLastModified, "dd:mm:yy"" à ""hh:mm")
'Date de dernier accès
Cells(ligne, 7) = Format(.DateLastAccessed, "dd:mm:yy"" à ""hh:mm")
'Atribut
'Cells(ligne, 8) = classeur.Attributes
'Répertoire court
'Cells(ligne, 9) = classeur.ShortPath
'Nom court
'Cells(ligne, 10) = classeur.ShortName
End With
End If
Next classeur
'--- Appel récursif pour lister les fichier dans les sous-répertoires ---.
For Each SubFolder In SourceFolder.SubFolders
ListeFichiers SubFolder.Path
Next SubFolder
Unload Me
End Sub
Private Sub Btn_Validation_Click()
Dim dossier As String
dossier = "nomdurépertoire"
Call ListeFichiers(dossier)
End Sub
Private Sub Btn_Bye_Click()
Unload Me
End Sub
Public Sub efface_contrats()
Dim i As Byte
For i = 1 To 10
Controls("clé_" & i).Text = ""
Next i
End Sub |
Formulaire qui remplit les cellules à la suite
Répondre avec citation
Pas de messagerie personnelle pour vos questions, s'il vous plaît. La réponse peut servir aux autres membres. Merci.
Partager