Thema: Dateiliste mit DOS- und Windowsnamen erstellen

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

Beiträge aus dem Excel-Forum zu den Themen Datei und Name