再びこんにちは。KenKen_SP です。
自分でも使うだろうからタイムスタンプの取得・設定をライブラリー化して
みました。ちょっと仰々しいコードですが、ご参考までで。
フォルダのタイムスタンプにも対応してます。（設定はNT系OSのみ）
詳しい説明は省略しますが、末尾のサンプルコードを見て下さい。
Option Explicit
'// Win32API ファイルを作成またはオープン
Private Declare Function CreateFile Lib "kernel32.dll" _
Alias "CreateFileA" ( _
ByVal lpFileName As String, _
ByVal dwdesiredAccess As Long, _
ByVal dwShareMode As Long, _
ByRef lpSecurityAttributes As SECURITY_ATTRIBUTES, _
ByVal dwCreationDisposition As Long, _
ByVal dwFlagsAndAttributes As Long, _
ByVal hTemplateFile As Long) As Long
'// Win32API ファイルやディレクトリの属性を取得
Private Declare Function GetFileAttributes Lib "kernel32.dll" _
Alias "GetFileAttributesA" ( _
ByVal lpFileName$) As Long
'// Win32API 開かれているオブジェクトのハンドルを開放
Private Declare Function CloseHandle Lib "kernel32.dll" ( _
ByVal hObject As Long) As Long
'// Win32API システムタイムをファイルタイムに変換する
Private Declare Function SystemTimeToFileTime Lib "kernel32.dll" ( _
ByRef lpSystemTime As SYSTEMTIME, _
ByRef lpFileTime As FILETIME) As Long
'// Win32API ローカルファイルタイムをUTCファイルタイム形式で取得する
Private Declare Function LocalFileTimeToFileTime Lib "kernel32.dll" ( _
ByRef lpLocalFileTime As FILETIME, _
ByRef lpFileTime As FILETIME) As Long
'// Win32API ファイルのファイルタイムを設定する
Private Declare Function SetFileTime Lib "kernel32.dll" ( _
ByVal hFile As Long, _
ByRef lpCreationTime As FILETIME, _
ByRef lpLastAccessTime As FILETIME, _
ByRef lpLastWriteTime As FILETIME) As Long
'// SECURITY_ATTRIBUTES 構造体
Private Type SECURITY_ATTRIBUTES
nLength As Long '構造体のバイト数
lpSecurityDescriptor As Long 'セキュリティデスクリプタ(Win95,98では無効)
bInheritHandle As Long '1のとき属性を継承する
End Type
'// SYSTEMTIME 構造体
Private Type SYSTEMTIME
wYear As Integer '年
wMonth As Integer '月
wDayOfWeek As Integer '曜日(日=0, 月=1 ...)
wDay As Integer '日
wHour As Integer '時
wMinute As Integer '分
wSecond As Integer '秒
wMilliseconds As Integer 'ミリ秒
End Type
'// FILETIME 構造体
Private Type FILETIME
dwLowDateTime As Long '下位32ビット値
dwHighDateTime As Long '上位32ビット値
End Type
'// 定数
Private Const FILE_FLAG_BACKUP_SEMANTICS As Long = &H2000000 'NT系OSのみ
Private Const GENERIC_READ As Long = &H80000000
Private Const GENERIC_WRITE As Long = &H40000000
Private Const FILE_SHARE_READ As Long = &H1
Private Const FILE_ATTRIBUTE_NORMAL As Long = &H80
Private Const OPEN_EXISTING As Long = 3
Private Const OPEN_ALWAYS As Long = 4
Private Const INVALID_HANDLE_VALUE As Long = &HFFFFFFFF
'// ファイルまたはフォルダのタイムスタンプ設定関数 2005/11/28
Public Function SetTIMESTAMP( _
ByVal strFULLPATH As String, _
Optional ByVal datCREATETIME As Date, _
Optional ByVal datACCESSTIME As Date, _
Optional ByVal datMODIFYTIME As Date) As Boolean
Dim lngHANDLE As Long
Dim lngFLAG As Long
Dim lngRET As Long
Dim udtCREATE As FILETIME
Dim udtACCESS As FILETIME
Dim udtMODIFY As FILETIME
Dim udtSEQRTY As SECURITY_ATTRIBUTES
Dim FSO As New FileSystemObject
Dim OBJ As Object
'// 対象の存在チェックとdwFlagsAndAttributes の設定
Set FSO = CreateObject("Scripting.FileSystemObject")
If FSO.FileExists(strFULLPATH) Then
'ファイルの場合
Set OBJ = FSO.GetFile(strFULLPATH)
lngFLAG = FILE_ATTRIBUTE_NORMAL
ElseIf FSO.FolderExists(strFULLPATH) Then
'フォルダの場合(NT系のOSのみ可能)
If InStr(Application.OperatingSystem, "NT") > 0 Then
Set OBJ = FSO.GetFolder(strFULLPATH)
lngFLAG = FILE_ATTRIBUTE_NORMAL Or FILE_FLAG_BACKUP_SEMANTICS
Else
GoTo TERMINATE
End If
Else
'ファイルもフォルダも見つからない場合
GoTo TERMINATE
End If
'// オプション引数が省略された場合は現状のものを補完
With OBJ
If datCREATETIME = 0 Then datCREATETIME = .DateCreated
If datACCESSTIME = 0 Then datACCESSTIME = .DateLastAccessed
If datMODIFYTIME = 0 Then datMODIFYTIME = .DateLastModified
End With
'// SECURITY_ATTRIBUTES構造体初期化
With udtSEQRTY
.nLength = LenB(udtSEQRTY)
.lpSecurityDescriptor = 0&
.bInheritHandle = 0&
End With
'// ファイルまたはフォルダハンドルを取得
lngHANDLE = CreateFile(strFULLPATH, GENERIC_WRITE, _
FILE_SHARE_READ, udtSEQRTY, OPEN_EXISTING, lngFLAG, vbNull)
If lngHANDLE = INVALID_HANDLE_VALUE Then GoTo TERMINATE
'// ファイルタイムに変換し、設定する
udtCREATE = GetFILETIME(datCREATETIME)
udtACCESS = GetFILETIME(datACCESSTIME)
udtMODIFY = GetFILETIME(datMODIFYTIME)
lngRET = SetFileTime(lngHANDLE, udtCREATE, udtCREATE, udtMODIFY)
If lngRET <> 0 Then SetTIMESTAMP = True
'// ファイルまたはフォルダハンドル開放
CloseHandle lngHANDLE
TERMINATE:
Set OBJ = Nothing
Set FSO = Nothing
End Function
'// ファイルまたはフォルダのタイムスタンプ取得関数 2005/11/28
Public Function GetTIMESTAMP( _
ByVal strFULLPATH As String, _
ByRef datCREATETIME As Date, _
ByRef datACCESSTIME As Date, _
ByRef datMODIFYTIME As Date) As Boolean
Dim FSO As Object 'New FileSystemObject
Dim OBJ As Object
Set FSO = CreateObject("Scripting.FileSystemObject")
If FSO.FileExists(strFULLPATH) Then
Set OBJ = FSO.GetFile(strFULLPATH)
ElseIf FSO.FolderExists(strFULLPATH) Then
Set OBJ = FSO.GetFolder(strFULLPATH)
Else
GoTo TERMINATE
End If
With OBJ
datCREATETIME = CDate(.DateCreated)
datACCESSTIME = CDate(.DateLastAccessed)
datMODIFYTIME = CDate(.DateLastModified)
End With
GetTIMESTAMP = True
TERMINATE:
Set OBJ = Nothing
Set FSO = Nothing
Exit Function
ERROR_HANDLER:
GetTIMESTAMP = 0
GoTo TERMINATE
End Function
'// UTCファイルタイム変換関数 2005/11/28
Private Function GetFILETIME(ByVal datPARAM As Date) As FILETIME
Dim udtSysTime As SYSTEMTIME
Dim udtLclTime As FILETIME
With udtSysTime
.wYear = Year(datPARAM)
.wMonth = Month(datPARAM)
.wDayOfWeek = Weekday(datPARAM)
.wDay = Day(datPARAM)
.wHour = Hour(datPARAM)
.wMinute = Minute(datPARAM)
.wSecond = Second(datPARAM)
.wMilliseconds = 0
End With
Call SystemTimeToFileTime(udtSysTime, udtLclTime)
Call LocalFileTimeToFileTime(udtLclTime, GetFILETIME)
End Function
'// 使い方サンプル
Sub SampleCode()
Dim strPATH As String
Dim datCREATETIME As Date
Dim datACCESSTIME As Date
Dim datMODIFYTIME As Date
strPATH = Application.GetOpenFilename("ファイル (*.*), *.*")
If UCase$(strPATH) = "FALSE" Then
Exit Sub
End If
'// タイムスタンプ取得サンプル
If GetTIMESTAMP(strPATH, datCREATETIME, datACCESSTIME, datMODIFYTIME) Then
MsgBox "タイムスタンプを取得しました" & vbCrLf & _
"CREATE:= " & CStr(datCREATETIME) & vbCrLf & _
"MODIFY:= " & CStr(datMODIFYTIME) & vbCrLf & _
"ACCESS:= " & CStr(datACCESSTIME) & vbCrLf, vbInformation
Else
MsgBox "タイムスタンプ取得に失敗しました", vbCritical
Exit Sub
End If
MsgBox "更新日時を現在（Now関数の戻り値）に設定します", vbInformation
'// タイムスタンプ設定サンプル
'更新日時を現在（Now関数の戻り値）に設定します
If SetTIMESTAMP(strPATH, , , Now()) Then
Call GetTIMESTAMP(strPATH, datCREATETIME, datACCESSTIME, datMODIFYTIME)
MsgBox "タイムスタンプを更新しました。" & vbCrLf & _
"CREATE:= " & CStr(datCREATETIME) & vbCrLf & _
"MODIFY:= " & CStr(datMODIFYTIME) & vbCrLf & _
"ACCESS:= " & CStr(datACCESSTIME) & vbCrLf, vbInformation
Else
MsgBox "タイムスタンプ設定に失敗しました", vbCritical
End If
End Sub
補足
すごい！すごい！すごい！の言葉しかでてきません！ 私が、質問をアップしたのが、21:28！ 第一回目のご指導が、日が変わって間もない1:44！ それを、ライブラリー化したのが、11:41！ 更に、訂正を加えたのが、12:22！ サスペンスドラマなら、この短時間で一人で犯行を犯すのは絶対に不可能！！この事件は、複数犯であると警部が断定し迷宮入りとなるでしょう！ 横に、見本があって、単に打ち込むだけでも、同じぐらいの時間がかかります。私は！しかも、内容の大部分が私の知っているベーシックではなく、ウルトラ文字で書いたてあり、辞書を片手に１字１字調べなきゃ読めん！！でも、使い方まで書いてある！！ あっ！判った！21:28以前に私が質問するのを察知していたのだなぁ？ って、感じです。感服致します。密かに、いつの日か？KenKen_SPのコードも素晴らしいのだけど、こんな表記もありますよ！！って、答える側に回ることを夢見ていましたが、現実を見ました。やはり、ガリバーには、カナイマセン！！師匠についていきます！何処までも！！ ショックが大きすぎて、お礼はまたの機会にします。ほんとうにありがとう御座いました。コードを打ち出して、壁に貼っておきます。今後とも宜しくお願いします。なんだか？質問が数行だけなのが申し訳ないです！！ (絶対に、読破してやる～！！)