VBA: Aktuelles Datei Datum/Speicherdatum

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
Bild

Betrifft: VBA: Aktuelles Datei Datum/Speicherdatum
von: Dieter
Geschrieben am: 13.07.2015 10:20:33

Guten Morgen, VBA Spezialisten,
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

Bild

Betrifft: AW: Sorry, ist schon alles im Makro. owT.
von: Dieter
Geschrieben am: 13.07.2015 11:25:35
Gruß, Dieter

 Bild

Beiträge aus den Excel-Beispielen zum Thema "VBA: Aktuelles Datei Datum/Speicherdatum"