Zurück zur Homepage

Dateizeiten ändern

Beispieldatei (Filetime.zip 16 KB)

Manchmal möchte man die Zeiten wie Erstellungsdatum, letzte Änderung und letzter Zugriff. von Datein auf einen bestimmten Stand bringen. Es gibt natürlich auch unehrenhafte Gründe dafür, beispielweise um zu verschleiern, dass man selbst eine bestimmte Datei vermurkst hat, aber mindestens genau so viel vernünftige Gründe. Ein solcher kann sein, Suchen nach bestimmten Dateien die zusammengehören, zu vereinfachen

Wie man das unter VBA mit Hilfe einiger API-Funktionen macht, zeigt folgender Code:

 

Option Explicit

Private Type FILETIME
   dwLowDateTime 
As Long
   dwHighDateTime 
As Long
End Type

Private 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

Private Type OPENFILENAME
   lStructSize 
As Long
   hwndOwner 
As Long
   hInstance 
As Long
   lpstrFilter 
As String
   lpstrCustomFilter 
As String
   nMaxCustFilter 
As Long
   nFilterIndex 
As Long
   lpstrFile 
As String
   nMaxFile 
As Long
   lpstrFileTitle 
As String
   nMaxFileTitle 
As Long
   lpstrInitialDir 
As String
   lpstrTitle 
As String
   flags 
As Long
   nFileOffset 
As Integer
   nFileExtension 
As Integer
   lpstrDefExt 
As String
   lCustData 
As Long
   lpfnHook 
As Long
   lpTemplateName 
As String
End Type

Private Declare Function CreateFile _
   
Lib "kernel32" Alias "CreateFileA" ( _
   
ByVal lpFileName As String, _
   
ByVal dwDesiredAccess As Long, _
   
ByVal dwShareMode As Long, _
   
ByVal lpSecurityAttributes As Long, _
   
ByVal dwCreationDisposition As Long, _
   
ByVal dwFlagsAndAttributes As Long, _
   
ByVal hTemplateFile As Long _
   ) 
As Long

Private Declare Function CloseHandle _
   
Lib "kernel32" ( _
   
ByVal hObject As Long _
   ) 
As Long

Private Declare Function SetFileTime _
   
Lib "kernel32" ( _
   
ByVal hFile As Long, _
   lpCreationTime 
As FILETIME, _
   lpLastAccessTime 
As FILETIME, _
   lpLastWriteTime 
As FILETIME _
   ) 
As Long

Private Declare Function SystemTimeToFileTime _
   
Lib "kernel32" ( _
   lpSystemTime 
As SYSTEMTIME, _
   lpFileTime 
As FILETIME _
   ) 
As Long

Private Const GENERIC_WRITE = &H40000000
Private Const OPEN_EXISTING = 3
Private Const FILE_SHARE_WRITE = &H2

Sub test()
FileZeitÄndern 
"c:\Testdaten.csv", _
   DateSerial(2000, 2, 1) + TimeSerial(12, 0, 0), _
   DateSerial(2000, 7, 1) + TimeSerial(12, 0, 0), _
   DateSerial(2000, 12, 1) + TimeSerial(12, 0, 0)
End Sub

Public Sub FileZeitÄndern( _
   
ByVal strFilename As String, _
   Erstellt 
As Date, _
   Geändert 
As Date, _
   LetzterZugriff 
As Date)
Dim hwndFile               As Long
Dim udtCreationFileTime    As FILETIME
Dim udtLastAccessFileTime  As FILETIME
Dim udtLastWriteFileTime   As FILETIME


If strFilename = "" Then Exit Sub

'Erstellungszeitpunkt
udtCreationFileTime = ToFileTime(Erstellt)

'Letzter Zugriff
udtLastAccessFileTime = ToFileTime(LetzterZugriff)

'Letzte Änderung
udtLastWriteFileTime = ToFileTime(Geändert)

'Filehandle holen
hwndFile = CreateFile(strFilename, GENERIC_WRITE, _
   FILE_SHARE_WRITE, 
ByVal 0&, OPEN_EXISTING, 0&, 0&)
   
'Filezeiten ändern
SetFileTime hwndFile, udtCreationFileTime, _
   udtLastAccessFileTime, udtLastWriteFileTime
   
'Filehandle schließen
CloseHandle hwndFile

End Sub


Private Function ToFileTime( _
   
ByVal Zeitpunkt As Date _
   ) 
As FILETIME
Dim udtSystemzeit As SYSTEMTIME

Zeitpunkt = Zeitpunkt - Offset

With udtSystemzeit
   .wYear = Year(Zeitpunkt)
   .wMonth = Month(Zeitpunkt)
   .wDay = Day(Zeitpunkt)
   .wDayOfWeek = Weekday(Zeitpunkt) - 1
   .wHour = Hour(Zeitpunkt)
   .wSecond = Second(Zeitpunkt)
End With

SystemTimeToFileTime udtSystemzeit, ToFileTime

End Function

Private Function Offset() As Date
Dim lngJahr    As Long
Dim dteBeginn  As Date
Dim dteEnde    As Date

   lngJahr = Year(Now)
   dteBeginn = DateSerial(lngJahr, 4, 0) - _
      (Weekday(DateSerial(lngJahr, 4, 0), 2) 
Mod 7) + _
      TimeSerial(2, 0, 0)
   dteEnde = DateSerial(lngJahr, 11, 0) - _
      (Weekday(DateSerial(lngJahr, 11, 0), 2) 
Mod 7) + _
      TimeSerial(2, 0, 0)
   
If Now > dteBeginn And Now < dteEnde Then
      Offset = TimeSerial(2, 0, 0)
   
Else
      Offset = TimeSerial(1, 0, 0)
   
End If

End Function