Windows Ordner Attribute Changer

Hallo,

hast du Microsoft Office auf deinem Rechner? Wenn ja, dann kannst du das mit diesem Makro machen:

Code:

Option Explicit

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 SetFileTime 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 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 SystemTimeToFileTime Lib "kernel32.dll" ( _
    ByRef lpSystemTime As SYSTEMTIME, _
    ByRef lpFileTime As FILETIME) As Long
Private Declare PtrSafe Function LocalFileTimeToFileTime Lib "kernel32.dll" ( _
    ByRef lpLocalFileTime As FILETIME, _
    ByRef lpFileTime As FILETIME) As Long
Private Declare PtrSafe Function CloseHandle Lib "kernel32.dll" ( _
    ByVal hObject As LongPtr) 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 Enum SELECTED_DATE
    DateCreate
    DateLastAccess
    DateLastModify
End Enum

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

Private Sub ChangeFileTime(ByVal pvstrPath As String, ByVal pvdtmNewDateTime As Date, ByVal enmSelectedDate As SELECTED_DATE)

    Dim udtFileTime1 As FILETIME, udtFileTime2 As FILETIME
    Dim udtFileTime3 As FILETIME, udtFileTimeNew As FILETIME
    Dim udtLocalTime As FILETIME, udtSystemTime As SYSTEMTIME
    Dim dtmNewFiletime As Date, lngptrHandle As LongPtr

    dtmNewFiletime = pvdtmNewDateTime

    udtSystemTime.wYear = Year(dtmNewFiletime)
    udtSystemTime.wMonth = Month(dtmNewFiletime)
    udtSystemTime.wDay = Day(dtmNewFiletime)
    udtSystemTime.wDayOfWeek = Weekday(dtmNewFiletime)
    udtSystemTime.wHour = Hour(dtmNewFiletime)
    udtSystemTime.wMinute = Minute(dtmNewFiletime)
    udtSystemTime.wSecond = Second(dtmNewFiletime)
    udtSystemTime.wMilliseconds = 0

    Call SystemTimeToFileTime(udtSystemTime, udtLocalTime)

    Call LocalFileTimeToFileTime(udtLocalTime, udtFileTimeNew)

    lngptrHandle = CreateFileA(pvstrPath, GENERIC_WRITE, FILE_SHARE_READ Or _
        FILE_SHARE_WRITE, ByVal 0&, OPEN_EXISTING, 0&, 0&)

    Call GetFileTime(lngptrHandle, udtFileTime1, udtFileTime2, udtFileTime3)

    Select Case enmSelectedDate
        Case DateCreate
            Call SetFileTime(lngptrHandle, udtFileTimeNew, udtFileTime2, udtFileTime3)
        Case DateLastAccess
            Call SetFileTime(lngptrHandle, udtFileTime1, udtFileTimeNew, udtFileTime3)
        Case DateLastModify
            Call SetFileTime(lngptrHandle, udtFileTime1, udtFileTime2, udtFileTimeNew)
    End Select

    Call CloseHandle(lngptrHandle)
End Sub

Public Sub Test()
    Call ChangeFileTime("G:\Eigene Dateien\Eigene Excelbeispiele\32_oder_64_Bit.xlsm", _
        DateSerial(2022, 4, 15) + TimeSerial(12, 0, 0), DateLastModify)
End Sub