[原创]文件时间修改工具

Day_DayUp

实用工具,感谢分享

niko88819

小师妹好想学习版主代码？出现文件代码损失,谁能帮忙，感恩加感谢，请把代码及文传到信箱，谢谢了！

jiaxinl

niko88819 发表于 2017-9-14 08:54
小师妹好想学习版主代码？出现文件代码损失,谁能帮忙，感恩加感谢，请把代码及文传到信箱，谢谢了！

请小师妹查收附件

niko88819

多谢大师兄，还是出现楼上情形耶，代码遗失了

jiaxinl

niko88819 发表于 2017-9-14 19:36
多谢大师兄，还是出现楼上情形耶，代码遗失了

也许窗体上有中文没有改到

jiaxinl

niko88819 发表于 2017-9-14 19:36
多谢大师兄，还是出现楼上情形耶，代码遗失了

请小师妹再次测试一下，见附件

zopey

'*********************************************************
'**             文件时间修改工具 V1.0                   ***
'**               taller@excelhome.net                     ***
'**                               2007.2.14                      ***
'*********************************************************

Option Explicit
Public Const OFS_MAXPATHNAME = 260
Public Const OF_READWRITE = &H2
Public Type OFSTRUCT
    cBytes As Byte
    fFixedDisk As Byte
    nErrCode As Integer
    Reserved1 As Integer
    Reserved2 As Integer
    szPathName(OFS_MAXPATHNAME) As Byte
End Type
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
Private Declare Function GetFileTime Lib "kernel32" (ByVal hFile As Long, lpCreationTime As FILETIME, lpLastAccessTime As FILETIME, lpLastWriteTime 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 SystemTimeToFileTime Lib "kernel32" (lpSystemTime As SYSTEMTIME, lpFileTime As FILETIME) As Long
Private Declare Function LocalFileTimeToFileTime Lib "kernel32" (lpLocalFileTime As FILETIME, lpFileTime As FILETIME) As Long
Private Declare Function FileTimeToSystemTime Lib "kernel32" (lpFileTime As FILETIME, lpSystemTime As SYSTEMTIME) As Long
Private Declare Function FileTimeToLocalFileTime Lib "kernel32" (lpFileTime As FILETIME, lpLocalFileTime As FILETIME) As Long
Private Declare Function OpenFile Lib "kernel32" (ByVal lpFileName As String, lpReOpenBuff As OFSTRUCT, ByVal wStyle As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hFile As Long) As Long
Sub ModifyFileTime(iTime As Date, iFile As String, Optional mSec As String = 0)
    Dim hFile As Long
    Dim OFS As OFSTRUCT
    Dim NEW_TIME As FILETIME, LOC_TIME As FILETIME
    Dim SYS_TIME As SYSTEMTIME
    With SYS_TIME
        .wYear = VBA.Year(iTime)
        .wMonth = VBA.Month(iTime)
        .wDay = VBA.Day(iTime)
        .wDayOfWeek = VBA.Weekday(iTime) - 1
        .wHour = VBA.Hour(iTime)
        .wMilliseconds = CInt(mSec)
        .wMinute = VBA.Minute(iTime)
        .wSecond = VBA.Second(iTime)
    End With
    Call SystemTimeToFileTime(SYS_TIME, LOC_TIME)
    Call LocalFileTimeToFileTime(LOC_TIME, NEW_TIME)
    hFile = OpenFile(iFile, OFS, OF_READWRITE)
    Call SetFileTime(hFile, NEW_TIME, NEW_TIME, NEW_TIME)
    CloseHandle hFile
End Sub
Function ReadFileTime(iFile As String) As String
    Dim Ft1 As FILETIME, Ft2 As FILETIME, SysTime As SYSTEMTIME
    Dim hFile As Long
    Dim OFS As OFSTRUCT
    hFile = OpenFile(iFile, OFS, OF_READWRITE)
    GetFileTime hFile, Ft1, Ft1, Ft2
    FileTimeToLocalFileTime Ft2, Ft1
    FileTimeToSystemTime Ft1, SysTime
    ReadFileTime = CDate(VBA.DateSerial(SysTime.wYear, SysTime.wMonth, SysTime.wDay) & " " & _
           VBA.TimeSerial(SysTime.wHour, SysTime.wMinute, SysTime.wSecond)) & "." & SysTime.wMilliseconds
    CloseHandle hFile
End Function
Function ListAllFile(iPath As String, srcSubFolder As Boolean)
    Dim FileName(), i As Integer
    With Application.FileSearch
        .NewSearch
        .LookIn = iPath
        .SearchSubFolders = srcSubFolder
        .FileName = "*.*"
        .MatchTextExactly = True
        .FileType = msoFileTypeAllFiles
        If .Execute() > 0 Then
            ReDim FileName(1 To .FoundFiles.Count)
            For i = 1 To .FoundFiles.Count
                FileName(i) = .FoundFiles(i)
            Next i
            ListAllFile = FileName()
        Else
            ListAllFile = ""
        End If
    End With
End Function

long635000

先收藏起来。希望能用上。

三流高手

谢谢楼主的分享

ggmmlol

zopey 发表于 2017-9-15 09:06
'*********************************************************
'**             文件时间修改工具 V1.0    ...

taller版主的这个小程序只能对文件修改时间，而不能对文件夹进行修改。关键原因在于所使用的打开API函数不对。

应当使用CreateFile函数而不是OpenFile函数。
CreateFile函数，可以打开已经存在的文件和文件夹，以便用其它API函数修改其创建时间等属性。