楼主
kevinchengcw |
Q: 如何用vba代码修改文件夹创建时间？
A: 代码如下：(下述代码不仅修改创建时间,还同时修改了最后访问时间及最后修改时间)- '声明需调用的API函数
- Public 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
- Public Declare Function SystemTimeToFileTime Lib "kernel32" (lpSystemTime As SYSTEMTIME, lpFileTime As FILETIME) As Long
- Public Declare Function SetFileTime Lib "kernel32" (ByVal hFile As Long, lpCreationTime As FILETIME, lpLastAccessTime As FILETIME, lpLastWriteTime As FILETIME) As Long
- Public Declare Function LocalFileTimeToFileTime Lib "kernel32" (lpLocalFileTime As FILETIME, lpFileTime As FILETIME) As Long
- Public Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
- '定义需引用的数据类型
- Public Type FILETIME
- dwLowDateTime As Long
- dwHighDateTime As Long
- End Type
- Public Type SECURITY_ATTRIBUTES
- nLength As Long
- lpSecurityDescriptor As Long
- bInheritHandle 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
- '定义要使用的常量
- Public Const GENERIC_READ = &H80000000
- Public Const GENERIC_WRITE = &H40000000
- Public Const FILE_SHARE_READ = &H1
- Public Const FILE_SHARE_WRITE = &H2
- Public Const OPEN_EXISTING = 3
- Public Const FILE_FLAG_BACKUP_SEMANTICS = &H2000000
- Public Const INVALID_HANDLE_value = -1
- '定义修改文件夹时间函数
- Public Function SetDirTime(DirName As String, NewTime As SYSTEMTIME) As Boolean
- Dim hDir As Long
- Dim lpCreationTime As FILETIME
- Dim lpLastAccessTime As FILETIME
- Dim lpLastWriteTime As FILETIME
- Dim lptLocalTime As FILETIME
- Dim RetVal As Boolean
- Dim sAttribute As SECURITY_ATTRIBUTES
- hDir = CreateFile(DirName, GENERIC_WRITE, FILE_SHARE_READ, sAttribute, OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS, 0) '打开目录获取句柄
- If hDir = INVALID_HANDLE_value Then '如果句柄无效返回False，退出函数
- SetDirTime = False
- Exit Function
- End If
- Call SystemTimeToFileTime(NewTime, lptLocalTime) '将输入时间转换为文件时间格式
- Call LocalFileTimeToFileTime(lptLocalTime, lpCreationTime) '将目录的创建时间修改为输入的文件时间
- Call LocalFileTimeToFileTime(lptLocalTime, lpLastAccessTime) '将目录最后访问时间修改为输入的文件时间
- Call LocalFileTimeToFileTime(lptLocalTime, lpLastWriteTime) '将目录最后修改时间修改为输入的文件时间
- RetVal = SetFileTime(hDir, lpCreationTime, lpLastAccessTime, lpLastWriteTime) '设置选定目录的各项时间修改为输入的时间并返回修改成功与否的逻辑值
- CloseHandle (hDir) '关闭目录句柄
- SetDirTime = RetVal '返回修改是否成功
- End Function
- Sub test()
- Dim NewTime As SYSTEMTIME
- With NewTime '设置输入时间(从当前日期时间提取对应内容)
- .wYear = Year(Date)
- .wMonth = Month(Date)
- .wDay = Day(Date)
- .wDayOfWeek = Weekday(Now)
- .wHour = Hour(Now)
- .wMinute = Minute(Now)
- .wSecond = Second(Now)
- End With
- Call SetDirTime(ThisWorkbook.Path & "\测试", NewTime) '调用自定义函数修改指定目录各项时间
- End Sub
具体详见附件,在当前文件目录下建立"测试"目录供测试.
 ModifyDirCreateTime.rar
 该帖已经同步到 kevinchengcw的微博 |
