API: Datum- und Zeitangaben von Dateien manipulieren

Dim oFSO As New FileSystemObject
Dim oFile As File

Private Enum eFileTime
    FileCreate = 1
    FileLastAccess = 2
    FileLastModify = 3
End Enum

Private Function GetFileTime(sFile As String, eType As eFileTime)
    Dim vResult
    Set oFile = oFSO.GetFile(sFile)
    If eType = FileCreate Then
        vResult = oFile.DateCreated
    ElseIf eType = FileLastAccess Then
        vResult = oFile.DateLastAccessed
    Else
        vResult = oFile.DateLastModified
    End If
    GetFileTime = vResult
End Function

Private Sub Befehl0_Click()
    MsgBox "Erstellt: " & GetFileTime("D:\users\Daten2\DK_EinsatzBE.mdb", FileCreate) & vbNewLine & _
        "Letzter Zugriff: " & GetFileTime("D:\users\Daten2\DK_EinsatzBE.mdb", FileLastAccess) & vbNewLine & _
        "Letzte Änderung: " & GetFileTime("D:\users\Daten2\DK_EinsatzBE.mdb", FileLastModify)
End Sub

Public Declare Function SystemTimeToFileTime _
    Lib "kernel32" ( _
    lpSystemTime As tpSystemTime, _
    lpFileTime As tpFileTime) As Long
Public Declare Function LocalFileTimeToFileTime _
    Lib "kernel32" ( _
    lpLocalFileTime As tpFileTime, _
    lpFileTime As tpFileTime) As Long
Public Declare Function OpenFile _
    Lib "kernel32" ( _
    ByVal lpFileName As String, _
    lpReOpenBuff As tpOpenFile, _
    ByVal wStyle As Long) As Long
Public Declare Function SetFileTime _
    Lib "kernel32" ( _
    ByVal hFile As Long, _
    lpCreationTime As tpFileTime, _
    lpLastAccessTime As tpFileTime, _
    lpLastWriteTime As tpFileTime) As Long
Public Declare Function CloseHandle _
    Lib "kernel32" ( _
    ByVal hObject As Long) As Long
Public Type tpSystemTime
    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
Public Type tpFileTime
    dwLowDateTime As Long
    dwHighDateTime As Long
End Type
Public Type tpOpenFile
    cBytes As Byte
    fFixedDisk As Byte
    nErrCode As Integer
    Reserved1 As Integer
    Reserved2 As Integer
    szPathName(128) As Byte
End Type
Public Const OF_READWRITE = &H2

Public Function SetTimeStamp(sFileName As String, _
    Optional dtCreationTime As Date, _
    Optional dtLastAccessTime As Date, _
    Optional dtLastWriteTime As Date) As Boolean
    Dim typST As tpSystemTime
    Dim typTemp As tpFileTime
    Dim i As Integer
    Dim arrTime(3) As Date
    Dim arrTimeStruct(3) As tpFileTime
    Dim typOF As tpOpenFile
    Dim lngRet As Long
    On Error GoTo SetTimeStamp_Error
    If dtCreationTime = 0 Then
        arrTime(0) = Now()
    Else
        arrTime(0) = CDate(dtCreationTime)
    End If
    If dtLastAccessTime = 0 Then
        arrTime(1) = arrTime(0)
    Else
        arrTime(1) = CDate(dtLastAccessTime)
    End If
    If dtLastWriteTime = 0 Then
        arrTime(2) = arrTime(1)
    Else
        arrTime(2) = CDate(dtLastWriteTime)
    End If
    For i = 0 To 2
        With typST
            .wYear = Year(arrTime(i))
            .wMonth = Month(arrTime(i))
            .wDayOfWeek = 0
            .wDay = Day(arrTime(i))
            .wHour = Hour(arrTime(i))
            .wMinute = Minute(arrTime(i))
            .wSecond = Second(arrTime(i))
            .wMilliseconds = 0
        End With
        lngRet = SystemTimeToFileTime(typST, typTemp)
        lngRet = LocalFileTimeToFileTime( _
            typTemp, arrTimeStruct(i))
    Next i
    lngRet = OpenFile(sFileName, typOF, OF_READWRITE)
    Call SetFileTime(lngRet, _
        arrTimeStruct(0), arrTimeStruct(1), arrTimeStruct(2))
    Call CloseHandle(lngRet)
    SetTimeStamp = True
    Exit Function
SetTimeStamp_Error:
    SetTimeStamp = False
End Function

SetTimeStamp "F:\Access\Oberflächeproggie.xls", "30.05.2008 12:00"