Изменить дату и время создания файла - VBA

Узнай цену своей работы

Формулировка задачи:

Можно ли средствами VBA изменить дату создания текстового файла?

Решение задачи: «Изменить дату и время создания файла»

textual
Листинг программы
Option Explicit
Public Const GENERIC_WRITE = &H40000000, GENERIC_READ = &H80000000, FILE_ATTRIBUTE_NORMAL = &H80, OPEN_EXISTING = 3
Public Type FileTime:  dwLowDateTime As Long:  dwHighDateTime As Long: End Type
Public 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
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
Declare Function SetFileTime Lib "kernel32" (ByVal hFile As Long, lpCreationTime As FileTime, lpLastAccessTime As FileTime, lpLastWriteTime As FileTime) As Long
Declare Function SystemTimeToFileTime Lib "kernel32" (lpSystemTime As SYSTEMTIME, lpFileTime As FileTime) As Long
Declare Function LocalFileTimeToFileTime Lib "kernel32" (lpFileTime As FileTime, lpLocalFileTime As FileTime) As Long
Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
 
Function DTtoFT(ByVal DT As Date) As FileTime
Dim ST As SYSTEMTIME, lTime As FileTime
ST.wYear = Year(DT): ST.wMonth = Month(DT): ST.wDay = Day(DT): ST.wHour = Hour(DT): ST.wMinute = Minute(DT): ST.wSecond = Second(DT)
SystemTimeToFileTime ST, lTime
LocalFileTimeToFileTime lTime, DTtoFT
End Function
 
Sub GetFTime(fName As String, Creation As Date, LastAccess As Date, LastWrite As Date)
Dim hFile As Long, ct As FileTime, at As FileTime, wt As FileTime
hFile = CreateFile(fName, GENERIC_READ, 0, 0, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0)
GetFileTime hFile, ct, at, wt
CloseHandle hFile
Creation = FTtoDT(ct): LastAccess = FTtoDT(at): LastWrite = FTtoDT(wt)
End Sub
 
Sub SetFTime(fName As String, Optional Creation As Date = -657434, Optional LastAccess As Date = -657434, Optional LastWrite As Date = -657434)
Dim hFile As Long, ct As Date, at As Date, wt As Date
If Creation = -657434 Or LastAccess = -657434 Or LastWrite = -657434 Then
  GetFTime fName, ct, at, wt
  If Creation = -657434 Then Creation = ct
  If LastAccess = -657434 Then LastAccess = at
  If LastWrite = -657434 Then LastWrite = wt
End If
hFile = CreateFile(fName, GENERIC_WRITE, 0, 0, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0)
SetFileTime hFile, DTtoFT(Creation), DTtoFT(LastAccess), DTtoFT(LastWrite)
CloseHandle hFile
End Sub
 
Sub SetFT()
Dim T1 As Date, T2 As Date, T3 As Date
T1 = Now 'Creation As Date - сейчас
T2 = T1 + 2 'LastAccess As Date - послезавтра в это же время
T3 = T1 + 1 'LastWrite As Date - завтра в это же время
'собственно примерчик
SetFTime "d:\tmp\123.txt", T1, T2, T3
'
End Sub

ИИ поможет Вам:


  • решить любую задачу по программированию
  • объяснить код
  • расставить комментарии в коде
  • и т.д
Попробуйте бесплатно

Оцени полезность:

15   голосов , оценка 3.733 из 5