Dateiinformationen auslesen und in Excel erfassen per VBA-Code

30/08/2008 - 18:21 von Hermann Splitthoff | Report spam
Hallo liebe Leute,

mit dem weiter unten aufgeführten VBA-Code (hier aus der Newsgroup)
lese ich explizit Dateien bzw. deren Informationen auf einen Laufwerk
aus. Auf dem Laufwerk sind keine weiteren Pfade vorhanden. Diese
Informationen werden dann in einer Exceltabelle ausgegeben. Künftig
werden auch Unterordner auf dem Laufwerk vorhanden sein.

Wie ist dieser VBA-Code umzubauen, damit enthaltene Ordner (eine
Ebene) mit ausgelesen werden und wiederum in einer Exceltabelle – mit
Erweiterung der Ordnerangabe – ausgegeben werden? Ich bekomme den
Wechsel zwischen den Ordner nicht hin, ohne selber im VBA-Code
herumzufummeln. Das will ich eigentich vermeiden.

Hintergrund der Aktion ist, dass Sicherungsdateien auf einer
Festplatte (Laufwerk F:) kopiert werden und der Stand der Dateien
nachts als einfache DateiInformation gesichert werden sollen. Nun ist
die Anzahl der Dateien so groß geworden, dass je Jahr/Monat ein Ordner
(z.B. 2008_08) angelegt wird, so dass auf Laufwerk F: nur noch Pfade
liegen und darin die Dateien enthalten sind.

Bin für jede Hilfe dankbar.


Sub DateiInformationen_auslesen()
'
Dim Blatt As Worksheet
Dim Pfad As String
Dim DatNam As String
Dim i As Integer
'
Set Blatt = ThisWorkbook.Worksheets("Dateiinfos")
Pfad = "F:\"
DatNam = Dir(Pfad)
'
Sheets("Dateiinfos").Select
Range("A3:E10000").ClearContents
Range("A1").Select
'
With Blatt
.Cells(1, 1) = "Pfad:"
.Cells(1, 2) = Pfad
.Cells(2, 2) = "Name"
.Cells(2, 3) = "Datum"
.Cells(2, 4) = "Uhrzeit"
.Cells(2, 5) = "Größe"
.Cells(2, 6) = "Ordner" 'neue Spalte in Tabellenblatt
i = 3
'
Do While DatNam <> ""
.Cells(i, 2) = DatNam
.Cells(i, 3) = Int(FileDateTime(Pfad & DatNam))
.Cells(i, 4) = FileDateTime(Pfad & DatNam) -
Int(FileDateTime(Pfad & DatNam))
.Cells(i, 5) = FileLen(Pfad & DatNam)
'.Cells(i, 6) = 'neuer Eintrag zur Angabe des Ordners (?)
i = i + 1
DatNam = Dir
Loop
'
.Columns("C:C").NumberFormat = "DD.MM.YYYY"
.Columns("D:D").NumberFormat = "hh:mm:ss"
End With
'
End Sub

Schönen Gruß
Hermann
 

Lesen sie die antworten

#1 Peter Schleif
30/08/2008 - 19:44 | Warnen spam
Hermann Splitthoff schrieb am 30.08.2008 18:21 Uhr:

Wie ist dieser VBA-Code umzubauen, damit enthaltene Ordner (eine
Ebene) mit ausgelesen werden und wiederum in einer Exceltabelle – mit
Erweiterung der Ordnerangabe – ausgegeben werden?



Hallo Hermann.

Das Durchwandern eines Ordners mir Dir() ist IMHO nicht mehr
zeitgemàß. Dafür gibt es Objekte mit extra dafür vorgesehenen
Eigenschaften und Methoden. Zum Beispiel hat das Folder-Object eine
Files-Auflistung und eine SubFolders-Auflistung die man bequem mit
For-Each durchlaufen kann. Siehe dazu auch die Links am Ende diese
Postings.

Peter


Sub DateiInformationen_auslesen_Peter()
Dim fso As Object
Dim ordner As Object
Dim subordner As Variant
Dim file As Variant
Dim i As Integer

Const PFAD = "F:\"

i = 3
Set fso = CreateObject("Scripting.FileSystemObject")
Set ordner = fso.GetFolder(PFAD)

With ThisWorkbook.Worksheets("Dateiinfos")
.[A1].Select
.[A3:F10000].ClearContents
.[A1:B1] = Array("Pfad:", PFAD)
.[B2:F2] = Array("Name","Datum","Uhrzeit","Größe","Ordner")
.[C:C].NumberFormat = "dd.mm.yyyy"
.[D:D].NumberFormat = "hh:mm:ss"
.[E:E].NumberFormat = "#,##0"

For Each file In ordner.Files
.Cells(i, 2) = file.Name
.Cells(i, 3) = DateValue(file.DateLastModified)
.Cells(i, 4) = TimeValue(file.DateLastModified)
.Cells(i, 5) = file.Size
i = i + 1
Next

For Each subordner In ordner.SubFolders
If (subordner.Attributes And 4) = 0 Then
For Each file In subordner.Files
.Cells(i, 2) = file.Name
.Cells(i, 3) = DateValue(file.DateLastModified)
.Cells(i, 4) = TimeValue(file.DateLastModified)
.Cells(i, 5) = file.Size
.Cells(i, 6) = subordner.Name
i = i + 1
Next
End If
Next

.[A:F].EntireColumn.AutoFit
End With
End Sub


Folder-Object:
http://msdn.microsoft.com/en-us/library/1c87day3(VS.85).aspx

File-Object
http://msdn.microsoft.com/en-us/library/1ft05taf(VS.85).aspx

Files-Auflistung:
http://msdn.microsoft.com/en-us/library/wz72a8c0(VS.85).aspx

SubFolders-Auflistung:
http://msdn.microsoft.com/en-us/library/e1dthkks(VS.85).aspx

Ähnliche fragen