注意事項
本編は
http://jeanne.wankuma.com/tips/file/09-settimestamp.html
を発掘したものである。
Visual Basic 向けとなっているが当時のものであり、VBA7ではPtrsafeが必要と思われる。
ファイルのタイムスタンプの取得・設定
Visual Basicからファイルのタイムスタンプの取得・変更の方法は、いろんなところで取り上げられWindows APIを使った例としては割とポピュラーですが、その中でも私なりに重要だと思うノウハウを...。
ＡＰＩの宣言
Option Explicit
Private Const MAX_PATH = 260
Private Const INVALID_HANDLE_VALUE = (-1)
Private Type tagWIN32_FIND_DATA
dwFileAttributes As Long
ftCreationTime As Currency
ftLastAccessTime As Currency
ftLastWriteTime As Currency
nFileSizeHigh As Long
nFileSizeLow As Long
dwReserved0 As Long
dwReserved1 As Long
cFileName As String * MAX_PATH
cAlternateFileName As String * 14
End Type
Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" _
(ByVal lpFileName As String, _
lpFindFileData As tagWIN32_FIND_DATA) As Long
Private Declare Function FindClose Lib "kernel32" _
(ByVal hFindFile As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" _
(ByVal hObject As Long) As Long
Private Declare Function LocalFileTimeToFileTime Lib "kernel32" _
(lpLocalFileTime As Currency, _
lpFileTime As Currency) As Long
Private Declare Function FileTimeToLocalFileTime Lib "kernel32" _
(lpFileTime As Currency, _
lpLocalFileTime As Currency) As Long
Private Const conDayZeroBios As Double = 109205#
Private Const conMillisecondPerDay As Double = 10000000# * 60# * 60# * 24# / 10000#
Private Declare Function SetFileTime Lib "kernel32" _
(ByVal hFile As Long, _
lpCreationTime As Currency, _
lpLastAccessTime As Currency, _
lpLastWriteTime As Currency) As Long
Private 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
Private Const GENERIC_READ = &H80000000
Private Const GENERIC_WRITE = &H40000000
Private Const OPEN_EXISTING = 3
Private Type tagOSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128
End Type
Private Const VER_PLATFORM_WIN32_NT = 2
Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" _
(lpVersionInformation As tagOSVERSIONINFO) As Long
ファイルのタイムスタンプの取得
' ファイルのタイムスタンプを得る。
'
Public Sub GetFileTimeStamp(strFileName As String, _
dteCreateTime As Date, _
dteWriteTime As Date, _
dteAccessTime As Date)
Dim lngFindFileHandle As Long
Dim lngResult As Long
Dim lt As Currency
Dim wfd As tagWIN32_FIND_DATA
lngFindFileHandle = FindFirstFile(strFileName, _
wfd)
' If lngFindFileHandle <> 0 Then 2003/07/21 修正
If lngFindFileHandle <> INVALID_HANDLE_VALUE Then
' ハンドルをクローズする。
lngResult = FindClose(lngFindFileHandle)
' ローカル時間に変換する。
lngResult = FileTimeToLocalFileTime(wfd.ftCreationTime, lt)
' FILETIMEをＶＢの日付型に変換する。
dteCreateTime = CDate((lt / conMillisecondPerDay) - conDayZeroBios)
' ローカル時間に変換する。
lngResult = FileTimeToLocalFileTime(wfd.ftLastWriteTime, lt)
' FILETIMEをＶＢの日付型に変換する。
dteWriteTime = CDate((lt / conMillisecondPerDay) - conDayZeroBios)
' ローカル時間に変換する。
lngResult = FileTimeToLocalFileTime(wfd.ftLastAccessTime, lt)
' FILETIMEをＶＢの日付型に変換する。
dteAccessTime = CDate((lt / conMillisecondPerDay) - conDayZeroBios)
End If
End Sub
ファイルのタイムスタンプの変更
'
' ファイルのタイムスタンプを設定する。
'
Public Function SetFileTimeStamp(strFileName As String, _
dteCreateTime As Date, _
dteWriteTime As Date, _
dteAccessTime As Date) As Boolean
Dim lft As Currency
Dim cft As Currency
Dim wft As Currency
Dim aft As Currency
Dim lngResult As Long
Dim lngFileHandle As Long
Dim lngFlag As Long
Dim ovi As tagOSVERSIONINFO
' ＶＢの日付型をFILETIMEに変換する。
lft = CCur((dteCreateTime + conDayZeroBios) * conMillisecondPerDay)
' ローカル時間をUTC時間へ変換する。
lngResult = LocalFileTimeToFileTime(lft, cft)
' ＶＢの日付型をFILETIMEに変換する。
lft = CCur((dteWriteTime + conDayZeroBios) * conMillisecondPerDay)
' ローカル時間をUTC時間へ変換する。
lngResult = LocalFileTimeToFileTime(lft, wft)
' ＶＢの日付型をFILETIMEに変換する。
lft = CCur((dteAccessTime + conDayZeroBios) * conMillisecondPerDay)
' ローカル時間をUTC時間へ変換する。
lngResult = LocalFileTimeToFileTime(lft, aft)
ovi.dwOSVersionInfoSize = Len(ovi)
lngResult = GetVersionEx(ovi)
' OSがNTかどうか？
If ovi.dwPlatformId = VER_PLATFORM_WIN32_NT Then
Const FILE_FLAG_BACKUP_SEMANTICS = &H2000000
' OSがNTかどうか？
If ovi.dwPlatformId = VER_PLATFORM_WIN32_NT Then
Const FILE_FLAG_BACKUP_SEMANTICS = &H2000000
' このフラグを入れるとＯＳがＮＴの時のみディレクトリのハンドルを取得できる。
lngFlag = FILE_FLAG_BACKUP_SEMANTICS
End If
' ファイルを開いて、ファイルハンドルを取得する。
lngFileHandle = CreateFile(strFileName, _
GENERIC_READ Or GENERIC_WRITE, _
0, _
ByVal 0&, _
OPEN_EXISTING, _
lngFlag, _
0)
' If lngFileHandle <> 0 Then 2003/07/21 修正
If lngFileHandle <> INVALID_HANDLE_VALUE Then
' タイムスタンプを変更する。
lngResult = SetFileTime(lngFileHandle, _
cft, _
aft, _
wft)
If lngResult = 0 Then
SetFileTimeStamp = False
Else
SetFileTimeStamp = True
End If
' ファイルを閉じる。
Call CloseHandle(lngFileHandle)
Else
SetFileTimeStamp = False
End If
End Function