Auslesen von Dateieigenschaften

19/09/2007 - 10:14 von Reinhard | Report spam
Hallo,

ich möchte eine Liste der letzten Änderungen aus denDateieigenschaften von
diversen Exceldateien in einer Tabelle darstellen. Wie man dies in einer
geöffneten Datei macht, ist mir klar, aber wie geht es mit ungeöffneten?

bg

Reinhard
 

Lesen sie die antworten

#1 Robert Jakob
19/09/2007 - 11:51 | Warnen spam
Am Wed, 19 Sep 2007 01:14:01 -0700 schrieb Reinhard:

Hallo,

ich möchte eine Liste der letzten Änderungen aus denDateieigenschaften von
diversen Exceldateien in einer Tabelle darstellen. Wie man dies in einer
geöffneten Datei macht, ist mir klar, aber wie geht es mit ungeöffneten?

bg

Reinhard



Hallo Reinhard,

probiers mal damit:

Hinweis: In der Zelle D1 muß das Verzeichnis z.B. C:\Excel\
oder so àhnlich, je nach Deinem Verzeichnis angegeben werden.

Die Dateiliste wird in einer neuen leeren Tabelle ausgegeben.


hier der Code:

Option Explicit

Sub Dateiliste()

On Error GoTo Fehlermeldung1
Dim strOrdner As String
Dim fso As Object
Dim fsOrdner As Object
Dim fsDateien As Object, fsDatei As Object
Dim wb As Workbook, sh As Worksheet
Dim i As Long

strOrdner = Range("D1").Value
If strOrdner = Empty Then MsgBox "Es fehlt die Verzeichnisadresse in D1"
_
: Exit Sub
'Hinweis, in der Zelle Range("D1") muß das Verzeichnis z.B. C:\Excel\
'eingetragen sein, sonst làuft nix

Set fso = CreateObject("Scripting.FileSystemObject")
If Not fso.FolderExists(strOrdner) Then
MsgBox "Ordner nicht vorhanden."
Exit Sub
Else
Set fsOrdner = fso.GetFolder(strOrdner)
Set fsDateien = fsOrdner.Files
End If

Set wb = Application.Workbooks.Add
Set sh = wb.Worksheets(1)

With sh
.Cells(3, 1) = "Dateiname"
.Cells(3, 2) = "Dateigröße"
.Cells(3, 3) = "Dateityp"
.Cells(3, 4) = "Erstelldatum"
.Cells(3, 5) = "Letzter Zugriff"
.Cells(3, 6) = "Letzte Änderung"
.Rows(3).Font.Bold = True

i = 4
If fsDateien.Count > 0 Then
For Each fsDatei In fsDateien
.Cells(i, 1) = fsDatei.Name
.Cells(i, 2) = fsDatei.Size
.Cells(i, 3) = fsDatei.Type
.Cells(i, 4) = fsDatei.DateCreated
.Cells(i, 5) = fsDatei.DateLastAccessed
.Cells(i, 6) = fsDatei.DateLastModified
i = i + 1
Next fsDatei
Else
.Cells(i, 1) = "Keine Dateien"
End If

.Columns("A:F").AutoFit
.Cells(1, 1) = "Inhalt von " & strOrdner
.Cells(1, 1).Font.Bold = True
.Cells(1, 1).Font.Size = 12
End With

Set fsDatei = Nothing
Set fsDateien = Nothing
Set fsOrdner = Nothing
Set fso = Nothing
Set sh = Nothing
Set wb = Nothing
Range("A2").Select
Exit Sub

Fehlermeldung1:
MsgBox "Abbruchmeldung, es ist ein Fehler aufgetreten"
Exit Sub

End Sub

MfG
Robert

Ähnliche fragen