|
So?
Option Explicit
Const WKS_NAME As String = "Tabelle1" 'Tabelle, in der die Liste erzeugt werden soll
Const PFAD As String = "C:\usw." 'Pfad des Startverzeichnis
Dim fso As FileSystemObject
Dim wks As Worksheet
Dim f As folder
Public Sub list_all_files()
Set fso = New FileSystemObject
Set wks = Worksheets(WKS_NAME)
With wks
.Cells.ClearContents
.Cells(1, 1) = "DateiPfad"
.Cells(1, 2) = "Name"
.Cells(1, 3) = "Erstellungsdatum"
.Cells(1, 4) = "Dateityp"
.Cells(1, 5) = "Autor"
End With
Call get_all_files_of_subfolder(PFAD)
Set wks = Nothing
End Sub
Private Sub get_all_files_of_subfolder(ByVal sPfad As String)
Dim fo As folder
Dim sfo As Folders
Dim fi As file
Dim i As Integer
Set fo = fso.GetFolder(sPfad)
Set sfo = fo.SubFolders
i = wks.Cells(wks.Rows.Count, 1).End(xlUp).Row + 1
For Each fi In fo.Files
With wks
.Cells(i, 1) = fi.Path
.Cells(i, 2) = fi.Name
.Cells(i, 3) = fi.DateCreated
.Cells(i, 4) = fi.Type
.Cells(i, 5) = get_file_author(fi.Path)
End With
i = i + 1
Next
For Each f In sfo
Call get_all_files_of_subfolder(f.Path)
Next
End Sub
Private Function get_file_author(ByVal sPfad As String) As String
Dim oShell As Object
Set oShell = CreateObject("Shell.Application")
With oShell.Namespace(fso.GetParentFolderName(sPfad))
get_file_author = .GetDetailsOf(.Items.Item(fso.GetFileName(sPfad)), 20)
End With
Set oShell = Nothing
End Function
Gruß
|