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
| Option Explicit
Sub ListFilesInFolder(strFolderName As String, bIncludeSubfolders As Boolean)
' adapté de Ole P Erlandsen
' necessite d'activer la reference Microsoft Scripting RunTime
Static FSO As FileSystemObject
Dim oSourceFolder As Scripting.Folder
Dim oSubFolder As Scripting.Folder
Dim oFile As Scripting.File
Static wksDest As Worksheet
Static iRow As Long
Static bNotFirstTime As Boolean
If Not bNotFirstTime Then
Set wksDest = ActiveSheet ' A adtapter
Set FSO = CreateObject("Scripting.FileSystemObject")
With wksDest
.Cells(1, 1) = "Parent folder"
.Cells(1, 2) = "Full path"
.Cells(1, 3) = "File name"
.Cells(1, 4) = "Size"
.Cells(1, 5) = "Type"
.Cells(1, 6) = "Date created"
.Cells(1, 7) = "Date last modified"
.Cells(1, 8) = "Date last accessed"
.Cells(1, 9) = "Attributes"
.Cells(1, 10) = "Short path"
.Cells(1, 11) = "Short name"
End With
iRow = 2
bNotFirstTime = True
End If
Set oSourceFolder = FSO.GetFolder(strFolderName)
For Each oFile In oSourceFolder.Files
With wksDest
.Cells(iRow, 1) = oFile.ParentFolder.Path
.Cells(iRow, 2) = oFile.Path
.Cells(iRow, 3) = oFile.Name
.Cells(iRow, 4) = oFile.Size
.Cells(iRow, 5) = oFile.Type
.Cells(iRow, 6) = oFile.DateCreated
.Cells(iRow, 7) = oFile.DateLastModified
.Cells(iRow, 8) = oFile.DateLastAccessed
.Cells(iRow, 9) = oFile.Attributes
.Cells(iRow, 10) = oFile.ShortPath
.Cells(iRow, 11) = oFile.ShortName
End With
iRow = iRow + 1
Next oFile
For Each oSubFolder In oSourceFolder.SubFolders
' On peut mettre ici un traitement spécifique pour les dossiers
Next oSubFolder
If bIncludeSubfolders Then
For Each oSubFolder In oSourceFolder.SubFolders
ListFilesInFolder oSubFolder.Path, True
Next oSubFolder
End If
End Sub
Private Sub Lister_Fichiers_Sous_Dossiers()
ListFilesInFolder "C:\Users\E5922\Desktop\PowerPoints", True
End Sub |
