Afficher une liste de fichiers dans Excel

[EmmaZL]

Bonjour,

j'ai trouvé sur ce forum 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

.Formula = FileItem.Author

Mais ça ne fonctionne pas.

Voici le script en entier :

'========================================
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.