楼主
amulee |
与获取时间相反的过程，当然使用的API也有所不同。但是原理非常简单。
- Private Declare Function SystemTimeToFileTime Lib "kernel32" (lpSystemTime As SYSTEMTIME, lpFileTime As FILETIME) 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 LocalFileTimeToFileTime Lib "kernel32" (lpLocalFileTime As FILETIME, lpFileTime As FILETIME) As Long
- Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, lpSecurityAttributes As SECURITY_ATTRIBUTES, 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
- '文件结构
- Type FILETIME
- dwLowDateTime As Long
- dwHighDateTime As Long
- End Type
- Type SECURITY_ATTRIBUTES
- nLength As Long
- lpSecurityDescriptor As Long
- bInheritHandle As Long
- End Type
- Type WIN32_FIND_DATA
- dwFileAttributes As Long
- ftCreationTime As FILETIME
- ftLastAccessTime As FILETIME
- ftLastWriteTime As FILETIME
- nFileSizeHigh As Long
- nFileSizeLow As Long
- dwReserved0 As Long
- dwReserved1 As Long
- cFileName As String * 255
- cAlternate As String * 14
- 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 = &H40000000
- Private Const OPEN_EXISTING = 3
- Private Const FILE_SHARE_READ = &H1
- Private Const FILE_SHARE_WRITE = &H2
- Sub Test()
- Dim FindData As WIN32_FIND_DATA
- Dim CTime As FILETIME, LATime As FILETIME, LWTime As FILETIME
- Dim CTime1 As FILETIME, LATime1 As FILETIME, LWTime1 As FILETIME
- Dim CTime2 As SYSTEMTIME, LATime2 As SYSTEMTIME, LWTime2 As SYSTEMTIME
- Dim SA As SECURITY_ATTRIBUTES
- Dim FileHandle As Long
- Dim SetHandle As Long
- Dim TimeHandle As Long
- Dim FPath As String
- Dim StrA As String
- Dim dtNew As Date
- FPath = ThisWorkbook.Path & "\1.txt"
- dtNew = Now
- '设定创建时间
- CTime2.wYear = Year(dtNew)
- CTime2.wMonth = Month(dtNew)
- CTime2.wDay = Day(dtNew)
- CTime2.wHour = Hour(dtNew)
- CTime2.wMinute = Minute(dtNew)
- CTime2.wSecond = Second(NdtNew)
- '设定最后访问
- LATime2.wYear = Year(dtNew)
- LATime2.wMonth = Month(dtNew)
- LATime2.wDay = Day(dtNew)
- LATime2.wHour = Hour(dtNew)
- LATime2.wMinute = Minute(dtNew)
- LATime2.wSecond = Second(NdtNew)
- '设定最后修改
- LWTime2.wYear = Year(dtNew)
- LWTime2.wMonth = Month(dtNew)
- LWTime2.wDay = Day(dtNew)
- LWTime2.wHour = Hour(dtNew)
- LWTime2.wMinute = Minute(dtNew)
- LWTime2.wSecond = Second(NdtNew)
- '时间转换为文件时间
- SystemTimeToFileTime CTime2, CTime1
- SystemTimeToFileTime LATime2, LATime1
- SystemTimeToFileTime LWTime2, LWTime1
- '本地时间转换为标准时间
- LocalFileTimeToFileTime CTime1, CTime
- LocalFileTimeToFileTime LATime1, LATime
- LocalFileTimeToFileTime LWTime1, LWTime
- '打开文件，获取文件句柄
- FileHandle = CreateFile(FPath, GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, SA, OPEN_EXISTING, 0, 0)
- '写入时间
- SetHandle = SetFileTime(FileHandle, CTime, LATime, LWTime)
- '关闭文件
- CloseHandle FileHandle
- If SetHandle <> 0 Then MsgBox "修改成功" Else MsgBox "修改失败"
- End Sub
如果要批量只需要在下面语句两端加上循环修改不同的FPath即可
- '打开文件，获取文件句柄
- FileHandle = CreateFile(FPath, GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, SA, OPEN_EXISTING, 0, 0)
- '写入时间
- SetHandle = SetFileTime(FileHandle, CTime, LATime, LWTime)
- '关闭文件
- CloseHandle FileHandle
附件参考：
 API修改文件创建时间、最后修改时间、最后访问时间.rar
|