Sub Dateienauslesen()Code eingefügt mit Syntaxhighlighter 1.14
Dim s_Dateiname As String
Dim i As Integer
Dim fs As FileSystemObject
Dim f As Object
i = 1
Cells(i, 1).Value = "Dateiname"
Cells(i, 2).Value = "Letzte ÄÄnderung"
Cells(i, 3).Value = "Erstellungsdatum"
Cells(i, 4).Value = "Letzter Zugriff"
Cells(i, 5).Value = "Größe"
Cells(i, 6).Value = "Typ"
Range(Cells(i, 1), Cells(i, 6)).Font.Bold = True
On Error Goto Ende:
ChDir "D:\Eigene Dateien\"
s_Dateiname = Dir$("D:\Eigene Dateien\*.*")
Do While s_Dateiname <> ""
i = i + 1
Cells(i, 1).Value = s_Dateiname
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFile(s_Dateiname)
Cells(i, 2).Value = f.DateLastModified
Cells(i, 3).Value = f.DateCreated
Cells(i, 4).Value = f.DateLastAccessed
Cells(i, 5).Value = f.Size
Cells(i, 6).Value = f.Type
s_Dateiname = Dir$()
Loop
ActiveSheet.Columns("A:F").AutoFit
Exit Sub
Ende:
MsgBox "Das angegebene Verzeichnis existiert nicht!", vbCritical
End Sub
Sub DateiEigenchaften()
Worksheets("Tabelle1").Activate
For rw = 1 To 30
On Error Resume Next
Cells(rw, 1) = ActiveWorkbook.BuiltinDocumentProperties(rw).Name
Cells(rw, 2) = ActiveWorkbook.BuiltinDocumentProperties(rw).Value
Next
End Sub
Marc