Option
Explicit
Const
WKS_NAME
As
String
=
"Tabelle1"
Const
PFAD
As
String
=
"C:\usw."
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