Problemstellung:
Wie kann ich mit API Datum- und Zeitangaben von Dateien manipulieren?
Mit dem Filesystemobject der MS-Scripting Runtime ist es kein Problem die
3 Zeitangaben von Dateien auslesen (Erstellt, letzte Änderung und letzter Zugriff)
z.B. so:
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
Ergebnis:
Aber es ist mit FSO eben nur möglich diese Angaben auszulesen aber nicht zu verändern.
Wie das geht möchte ich hier zeigen.
Lösung:
Nur für 32Bit Office Versionen
Folgenden Code in ein neues Modul kopieren.
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
Aufruf z.B.:
SetTimeStamp "F:\Access\Oberflächeproggie.xls", "30.05.2008 12:00"
Würde das Erstelltdatum der Datei "F:\Access\Oberflächenproggi.xls" auf das Datum 30.05.2008 12:00 setzen.
Ähnliche Artikel
Weiterlesen...