VBA: Aktuelles Datei Datum/Speicherdatum
13.07.2015 10:20:33
Dieter
das folgende Makro (aus Herber's Forum) listet alle Dateien des PC's auf und funktioniert prima.
Ich hätte gerne eine Erweiterung, damit mir auch das Dateidatum/letztes Speicherdatum, ebenfalls mit aufgelistet wird.
Mit der Bitte um Anpassung/Erweiterung des Makros und Danke für evtl. Hilfe.
Gruß, Dieter
Option Explicit
'Dateiliste mit DOS- und Windowsnamen erstellen
'Problem: Wie kann ich im aktuellen Blatt alle Dateien des Rechners listen? Ich benötige Angaben über DOS- und Windows-Namen, Erstellungs- und Änderungsdatum.
'StandardModule: basMain
'Michael Schwimmer
Declare
Function FindClose Lib "kernel32" _
(ByVal hFindFile As Long) As Long
Declare
Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" _
(ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Declare
Function FindNextFile Lib "kernel32" Alias "FindNextFileA" _
(ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
Public Const FILE_ATTRIBUTE_DIRECTORY = &H10
Public Const MAX_PATH = 260
Declare
Function FileTimeToSystemTime Lib "kernel32" _
(lpFileTime As FILETIME, lpSystemTime As SYSTEMTIME) As Long
Type SYSTEMTIME
wYear As Integer
wMonth As Integer
wDayOfWeek As Integer
wDay As Integer
wHour As Integer
wMinute As Integer
wSecond As Integer
wMilliseconds As Integer
End Type
Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Type WIN32_FIND_DATA
dwFileAttributes As Long
ftCreationTime As FILETIME
ftLastAccessTime As FILETIME
ftLastWriteTime As FILETIME
nFileSizeHigh As Long
nFileSizeLow As Long
dwReserved0 As Long
dwReserved1 As Long
cFileName As String * MAX_PATH
cAlternate As String * 14
End Type
Type Dateistruktur
Datei As String
MSDOSName As String
Pfad As String
KompletterPfad As String
Erstellungsdatum As String
LetzterZugriff As String
LetzteÄnderung As String
Größe As Long
End Type
Dim Dateiliste() As Dateistruktur
Sub DateilisteErstellen()
ReDim Dateiliste(1000)
Dim Zähler As Long
Dim Pfad As String
Dim AnzahlDateien As Long
Dim Datenblock(1 To 7)
Pfad = InputBox("Bitte Pfad eingeben:", , "c:")
If Right(Pfad, 1) = "\" Then Pfad = Left(Pfad, Len(Pfad) - 1)
AnzahlDateien = DurchlaufePfad(Pfad, 1)
For Zähler = 1 To AnzahlDateien
Datenblock(1) = Dateiliste(Zähler).Datei
Datenblock(2) = Dateiliste(Zähler).MSDOSName
Datenblock(3) = Dateiliste(Zähler).KompletterPfad
Datenblock(4) = Dateiliste(Zähler).Erstellungsdatum
Datenblock(5) = Dateiliste(Zähler).LetzteÄnderung
Datenblock(6) = Dateiliste(Zähler).LetzterZugriff
Datenblock(7) = Dateiliste(Zähler).Größe
Range(Cells(Zähler + 1, 1), Cells(Zähler + 1, 7)) = _
Datenblock
Next
Columns.AutoFit
End Sub
Function DurchlaufePfad(ByVal Pfadname As String, _
ByVal Dateiindex As Long) As Long
Dim Suchhandle As Long
Dim Rückgabewert1 As Long
Dim dummy
Dim Suchkriterium As String
Dim Zeile As Long
Dim Erstellungsdatum As Date
Dim Datumszwischenspeicher As SYSTEMTIME
Dim Filedaten As WIN32_FIND_DATA
Pfadname = Trim(Pfadname)
If Right$(Pfadname, 1) = "\" Then
Suchkriterium = Pfadname & "*"
Else
Suchkriterium = Pfadname & "\*"
End If
Zeile = Dateiindex
Filedaten.cAlternate = String(14, Chr(0))
Filedaten.cFileName = String(260, Chr(0))
Suchhandle = FindFirstFile(Suchkriterium, Filedaten)
Rückgabewert1 = Suchhandle
Do While Rückgabewert1 0
Filedaten.cFileName = Left(Filedaten.cFileName, InStr _
(1, Filedaten.cFileName, Chr(0)) - 1)
Filedaten.cAlternate = Left(Filedaten.cAlternate, InStr _
(1, Filedaten.cAlternate, Chr(0)) - 1)
If Trim(Filedaten.cFileName) "." And Trim _
(Filedaten.cFileName) ".." Then
If Filedaten.dwFileAttributes = FILE_ATTRIBUTE_DIRECTORY Then
Zeile = DurchlaufePfad((Pfadname & "\" & _
Trim(Filedaten.cFileName)), Zeile)
End If
If Zeile = UBound(Dateiliste) Then ReDim _
Preserve Dateiliste(Zeile + 100)
Dateiliste(Zeile).Datei = Trim(Filedaten.cFileName)
Dateiliste(Zeile).MSDOSName = Trim(Filedaten.cAlternate)
Dateiliste(Zeile).Pfad = Pfadname
Dateiliste(Zeile).KompletterPfad = Pfadname & "\" & _
Dateiliste(Zeile).Datei
dummy = FileTimeToSystemTime(Filedaten.ftCreationTime, _
Datumszwischenspeicher)
Dateiliste(Zeile).Erstellungsdatum = DateSerial _
(Datumszwischenspeicher.wYear, Datumszwischenspeicher.wMonth, _
Datumszwischenspeicher.wDay) _
+ TimeSerial(Datumszwischenspeicher.wHour, _
Datumszwischenspeicher.wMinute, Datumszwischenspeicher.wSecond)
dummy = FileTimeToSystemTime(Filedaten.ftLastAccessTime, _
Datumszwischenspeicher)
Dateiliste(Zeile).LetzterZugriff = DateSerial( _
Datumszwischenspeicher.wYear, Datumszwischenspeicher.wMonth, _
Datumszwischenspeicher.wDay) _
+ TimeSerial(Datumszwischenspeicher.wHour, _
Datumszwischenspeicher.wMinute, Datumszwischenspeicher.wSecond)
dummy = FileTimeToSystemTime(Filedaten.ftLastWriteTime, _
Datumszwischenspeicher)
Dateiliste(Zeile).LetzteÄnderung = _
DateSerial(Datumszwischenspeicher.wYear, _
Datumszwischenspeicher.wMonth, Datumszwischenspeicher.wDay) _
+ TimeSerial(Datumszwischenspeicher.wHour, _
Datumszwischenspeicher.wMinute, Datumszwischenspeicher.wSecond)
Dateiliste(Zeile).Größe = Filedaten.nFileSizeLow
Zeile = Zeile + 1
End If
Filedaten.cAlternate = String(14, Chr(0))
Filedaten.cFileName = String(260, Chr(0))
Rückgabewert1 = FindNextFile(Suchhandle, Filedaten)
Loop
DurchlaufePfad = Zeile
dummy = FindClose(Suchhandle)
End Function