AW: Dateiattribute
20.05.2019 18:14:49
Nepumuk
Hallo Albrecht,
teste mal:
Option Explicit
Private Declare PtrSafe Function CreateFileA Lib "kernel32.dll" ( _
ByVal lpFileName As String, _
ByVal dwDesiredAccess As Long, _
ByVal dwShareMode As Long, _
ByRef lpSecurityAttributes As Long, _
ByVal dwCreationDisposition As Long, _
ByVal dwFlagsAndAttributes As Long, _
ByVal hTemplateFile As LongPtr) As LongPtr
Private Declare PtrSafe Function CloseHandle Lib "kernel32.dll" ( _
ByVal hObject As LongPtr) As Long
Private Declare PtrSafe Function GetFileTime Lib "kernel32.dll" ( _
ByVal hFile As LongPtr, _
ByRef lpCreationTime As FILETIME, _
ByRef lpLastAccessTime As FILETIME, _
ByRef lpLastWriteTime As FILETIME) As Long
Private Declare PtrSafe Function FileTimeToLocalFileTime Lib "kernel32.dll" ( _
ByRef lpFileTime As FILETIME, _
ByRef lpLocalFileTime As FILETIME) As Long
Private Declare PtrSafe Function FileTimeToSystemTime Lib "kernel32.dll" ( _
ByRef lpFileTime As FILETIME, _
ByRef lpSystemTime As SYSTEMTIME) As Long
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 Const GENERIC_WRITE As Long = &H40000000
Private Const FILE_SHARE_READ As Long = &H1
Private Const FILE_SHARE_WRITE As Long = &H2
Private Const OPEN_EXISTING As Long = 3&
Public Sub Test()
Dim dtmCreate As Date, dtmLastAccess As Date, dtmModify As Date
Call GetFileDateTime("G:\Eigene Dateien\Eigene PDF\pareto.pdf", dtmCreate, dtmLastAccess, dtmModify)
MsgBox "DateCreated " & CStr(dtmCreate)
MsgBox "LastAccess " & CStr(dtmLastAccess)
MsgBox "LastModified " & CStr(dtmModify)
End Sub
Public Sub GetFileDateTime( _
ByVal pvstrPath As String, _
ByRef prdtmCreate As Date, _
ByRef prdtmLastAccess As Date, _
ByRef prdtmModify As Date)
Dim lngptrHandle As LongPtr
Dim udtDateTimeIn1 As FILETIME, udtDateTimeIn2 As FILETIME, udtDateTimeIn3 As FILETIME
Dim udtDateTimeOut1 As FILETIME, udtDateTimeOut2 As FILETIME, udtDateTimeOut3 As FILETIME
Dim udtSysDateTime1 As SYSTEMTIME, udtSysDateTime2 As SYSTEMTIME, udtSysDateTime3 As SYSTEMTIME
lngptrHandle = CreateFileA(pvstrPath, GENERIC_WRITE, _
FILE_SHARE_READ Or FILE_SHARE_WRITE, ByVal 0&, OPEN_EXISTING, 0&, 0)
Call GetFileTime(lngptrHandle, udtDateTimeIn1, udtDateTimeIn2, udtDateTimeIn3)
Call CloseHandle(lngptrHandle)
Call FileTimeToLocalFileTime(udtDateTimeIn1, udtDateTimeOut1)
Call FileTimeToLocalFileTime(udtDateTimeIn2, udtDateTimeOut2)
Call FileTimeToLocalFileTime(udtDateTimeIn3, udtDateTimeOut3)
Call FileTimeToSystemTime(udtDateTimeOut1, udtSysDateTime1)
Call FileTimeToSystemTime(udtDateTimeOut2, udtSysDateTime2)
Call FileTimeToSystemTime(udtDateTimeOut3, udtSysDateTime3)
With udtSysDateTime1
prdtmCreate = DateSerial(.wYear, .wMonth, .wDay) + _
TimeSerial(.wHour, .wMinute, .wSecond)
End With
With udtSysDateTime2
prdtmLastAccess = DateSerial(.wYear, .wMonth, .wDay) + _
TimeSerial(.wHour, .wMinute, .wSecond)
End With
With udtSysDateTime3
prdtmModify = DateSerial(.wYear, .wMonth, .wDay) + _
TimeSerial(.wHour, .wMinute, .wSecond)
End With
End Sub
Gruß
Nepumuk
