Afficher une liste de fichiers dans Excel
Bonjour,
J'espère que je suis dans le bon forum. ;)
j'ai trouvé le script visual basic ci-dessous. Il permet d'afficher dans excel la liste des fichiers contenus dans un dossier, avec pour chaque fichier, certains attributs, comme la date de création par exemple.
Ce script est exactement ce qu'il me fallait. Le seul hic, c'est que j'ai absolument besoin d'afficher l'auteur du fichier.
J'ai essayé d'ajouter
Code:
.Formula = FileItem.Author
Mais ça ne fonctionne pas. :(
Voici le script en entier :
Code:
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
| '========================================
Option Explicit
Sub TestListFilesInFolder()
Dim RootFolder$
' dossier à scanner
RootFolder = ChoisirDossier
If RootFolder = "" Then Exit Sub
' create a new workbook for the file list
Workbooks.Add
' add headers
With Range("A1")
.Formula = " Contenu du dossier : " & RootFolder
.Font.Bold = True
.Font.Size = 12
End With
Range("A3").Formula = "Chemin : "
Range("B3").Formula = "Nom : "
Range("C3").Formula = "Date Création : "
Range("D3").Formula = "Date Dernier Accès : "
Range("E3").Formula = "Date Dernière Modif : "
With Range("A3:E3")
.Font.Bold = True
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
End With
' list all files included subfolders
ListFilesInFolder RootFolder, True
Columns("A:H").AutoFit
End Sub
Sub ListFilesInFolder(SourceFolderName As String, IncludeSubfolders As Boolean)
' lists information about the files in SourceFolder
' example: ListFilesInFolder "C:\FolderName\", True
' Ole P Erlandsen (modifié fs 11/8/01)
Dim FSO 'As Scripting.FileSystemObject
Dim SourceFolder 'As Scripting.Folder
Dim SubFolder 'As Scripting.Folder
Dim FileItem 'As Scripting.File
Dim r As Long
Set FSO = CreateObject("Scripting.FileSystemObject")
Set SourceFolder = FSO.GetFolder(SourceFolderName)
r = Range("A65536").End(xlUp).Row + 1
For Each FileItem In SourceFolder.Files
' display file properties
Cells(r, 1).Formula = FileItem.ParentFolder
Cells(r, 2).Formula = FileItem.Name
Cells(r, 3).Formula = FileItem.DateCreated
Cells(r, 3).NumberFormatLocal = "jj/mm/aa"
Cells(r, 4).Formula = FileItem.DateLastAccessed
Cells(r, 5).Formula = FileItem.DateLastModified
Cells(r, 5).NumberFormatLocal = "jj/mm/aa"
' next row number
r = r + 1
Next FileItem
If IncludeSubfolders Then
For Each SubFolder In SourceFolder.SubFolders
ListFilesInFolder SubFolder.Path, True
Next SubFolder
End If
Set FileItem = Nothing
Set SourceFolder = Nothing
Set FSO = Nothing
ActiveWorkbook.Saved = True
End Sub
Private Function ChoisirDossier()
Dim objShell, objFolder, chemin, SecuriteSlash
Set objShell = CreateObject("Shell.Application")
Set objFolder = _
objShell.BrowseForFolder(&H0&, "Choisisser un répertoire", &H1&)
On Error Resume Next
chemin = objFolder.ParentFolder.ParseName(objFolder.Title). Path & ""
If objFolder.Title = "Bureau" Then
chemin = "C:\Windows\Bureau"
End If
If objFolder.Title = "" Then
chemin = ""
End If
SecuriteSlash = InStr(objFolder.Title, ":")
If SecuriteSlash > 0 Then
chemin = Mid(objFolder.Title, SecuriteSlash - 1, 2) & ""
End If
ChoisirDossier = chemin
End Function
'============================================ |
merci d'avance si quelqu'un peut m'expliquer comment faire. ;)
