【ExcelVBA】ファイルのタイムスタンプを一括で指定変更する

ファイルのタイムスタンプを変更したい時ってありませんか？
変更しようと思うのは、Excelファイルだけでなく、その他すべてのファイルのタイムスタンプです
前記事でShellApplicationで更新日時を変える（元に戻す）処理を説明しましたが、Shellで変更できるのは「DateLastModified ‘ 更新日時」だけなんです
残る「DateCreated ‘ 作成日時」と「DateLastAccessed ‘ アクセス日時」の変更には、Win32APIを使うしかないんですよね

ということで、今回はファイルのタイムスタンプ変更をWin32APIを使って処理する方法について紹介していきます。変更したい方、変更したくない方のどちらにもお役に立てる記事だと思いますので是非ご覧ください（ちょっと長いけど(^^;）

ExcelVBAからAPIを使ってすべてのファイルのタイムスタンプを変更する方法の紹介

タイムスタンプの変更について
1. タイムスタンプとは
2. タイムスタンプ変更の必要性
Win32APIを使う設定を行う
1. 使用するAPIの変数などの宣言を行う
タイムスタンプ変更の動作設定を考える
1. 動作させるためのシートを用意します
動作させるためのVBAコード
まとめ（おわりに）
1. 注意事項の確認と感想など
2. 今後の記事について
サンプルファイルをダウンロードできます（下記リンク先へ）

タイムスタンプの変更について

タイムスタンプとは

ファイルのタイムスタンプは「作成日時」「更新日時」「アクセス日時」の3種類があります
タイムスタンプとは「作成時刻」とか、「更新時刻」とか、「アクセス時刻」とか、電子データに対して付与される時刻を表す情報のことです

タイムスタンプ変更の必要性

ファイルのタイムスタンプは、ファイルを作成・変更したときに Windows が自動的に設定してくれるものですが、意図的にタイムスタンプを操作したい場合や操作した方が良い場合も少なくありません。例えば、デジカメで撮った写真など、写りを修正するために画像の回転や露出の変更をしたとします。この時にもし画像ファイルのタイムスタンプが変わってしまうと、ファイルの日付が画像を修正したときの時刻になってしまいます。最初に撮影した日時がわからなくなってしまいまうこともあり得ます。その他にも、作成したファイルを配布する場合など、いろいろなケースで作成日や更新日を変更したい場合や、変更したくない場合が数多く想定されると思います

また、「更新日が作成日より前になってしまう問題」や「最新アクセス日が更新日より古くなってしまう問題」の解決にもお役に立てるのではないかと思っています

ファイルの変更履歴を残したくないような場合にはファイルの作成日時、変更日時をデータとして取っておき、ファイル編集後、そのデータを使ってタイムスタンプを元に戻すのも良いでしょう

Win32APIを使う設定を行う

使用するAPIの変数などの宣言を行う

タイムスタンプを変更するためには、下のコードを見ていただければわかるとおり
「CreateFile」「CloseHandle」「LocalFileTimeToFileTime」「SystemTimeToFileTime」「SetFileTime」などの関数の宣言のほか、必要な「定数」や「構造体」をModuleのGeneral部分に記述しておく必要があります

Option Explicit
'オブジェクトへのアクセスの種類を指定する定数の宣言
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 Declare Function CreateFile Lib "kernel32.dll" 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 Declare Function CloseHandle Lib "kernel32.dll" ( _
    ByVal hObject As Long _
    ) As Long

'ファイル時間をシステム時間に変換する関数の宣言
Private Declare Function LocalFileTimeToFileTime Lib "kernel32.dll" ( _
    ByRef lpLocalFileTime As FILETIME, _
    ByRef lpFileTime As FILETIME _
    ) As Long

'システム時間をファイル時間に変換する関数の宣言(SYSTEMTIME構造体へのポインタを指定)
Private Declare Function SystemTimeToFileTime Lib "kernel32.dll" ( _
    ByRef lpSystemTime As SYSTEMTIME, _
    ByRef lpFileTime As FILETIME _
    ) As Long

'ファイルの作成日時などを設定する関数の宣言（最終アクセス、最終更新）
Private Declare Function SetFileTime Lib "kernel32.dll" ( _
    ByVal cFile As Long, _
    ByRef lpCreationTime As FILETIME, _
    ByRef lpLastAccessTime As FILETIME, _
    ByRef lpLastWriteTime As FILETIME _
    ) As Long
'パラメータ
'hFile  日時を設定するファイルのハンドルを指定
'lpCreationTime 作成日時を保持(FILETIME構造体へのポインタ)
'lpLastAccessTime   最終アクセス日時(FILETIME構造体へのポインタ)
'lpLastWriteTime    最終更新日時(FILETIME構造体へのポインタ)
'戻り値  関数が成功すると､0 以外の値が返る(失敗すると0)

'システム日時を格納する構造体
Private Type SYSTEMTIME
    Year As Integer
    Month As Integer
    DayOfWeek As Integer
    Day As Integer
    Hour As Integer
    Minute As Integer
    Second As Integer
    Milliseconds As Integer
End Type

'ファイル時間を定義する構造体
Private Type FILETIME
    LowDateTime As Long
    HighDateTime As Long
End Type

タイムスタンプ変更の動作設定を考える

・Excelファイルだけでなくすべてのファイルの変更を可能にする
・変更前に現状のタイムスタンプを確認できるようにする⇒「タイムスタンプ確認」ボタン
・「作成」「更新」「アクセス」日時を個別に指定できるようにする
・「一括で変更」するモードと「個別ファイルごと」に変更するモードの両方に対応する
・失敗しても元に戻せるようにしたい（現状のタイムスタンプのコピーから復元する）

もっと細かい設定もありそうですが、今回は私が考えた必要な部分で設定しています

動作させるためのシートを用意します

・画像を用意しましたので確認してください。用意するのはこのシートだけです

・「タイムスタンプ確認」ボタンで、現状のタイムスタンプを取得してセルに表示します
・「選択して変更実行」ボタンは、「E3～G3」の設定で一括変更を行います
・「表示中の設定に変更を実行」ボタンは、個別のファイル毎に違う設定で変更します
　ただし、「E3～G3」に設定がある場合は個別設定を無視して一括で変更してしまうので注意！
・設定が不要なファイルの場合は、設定を空欄にしておけば変更しません（個別動作時）

動作させるためのVBAコード

ファイルのタイムスタンプを確認するためのコード

「タイムスタンプ確認」ボタンで起動させます

'ファイルのタイムスタンプを確認する処理
Sub GetFileTimeStmp()
    Dim fso As FileSystemObject
    Set fso = New FileSystemObject
    Dim selectFileName As Variant
    Dim PathName As String, fileName As String
    Dim tgFileName As Variant
    Dim d As Date, i As Long
    Dim f As File
    
    'ファイル選択ダイアログを表示
    selectFileName = _
        Application.GetOpenFilename( _
            FileFilter:="全てのファイル,*.*,Microsoft Excel,*.xls?", _
            FilterIndex:=1, _
            Title:="ファイルを選択してください（複数可）", _
            MultiSelect:=True)
    '選択されたファイルに対する処理
    If IsArray(selectFileName) Then
        Cells(1, 5) = ""
        Range(Cells(4, 4), Cells(1000, 7)) = "" 'とりあえず1000行まで
        fileName = selectFileName(1)
        PathName = Left$(fileName, InStrRev(fileName, "\", -1, vbTextCompare) - 1)
        Cells(1, 5) = PathName
        '全てのファイルに繰り返し処理を行う
        i = 3
        For Each tgFileName In selectFileName
            i = i + 1
            Set f = fso.GetFile(tgFileName) ' ファイルを取得
            
            Cells(i, 4) = f.Name
            d = f.DateCreated      ' 作成日時を取得
            Cells(i, 5) = d
            d = f.DateLastModified ' 更新日時を取得
            Cells(i, 6) = d
            d = f.DateLastAccessed ' アクセス日時を取得
            Cells(i, 7) = d        
        Next
    Else
        MsgBox ("ファイルを選択しないで終了！")
        Set fso = Nothing
        Exit Sub
    End If
    Set fso = Nothing    
End Sub

共通部分のコード

この部分がタイムスタンプ変更の「キモ」の部分です

'ファイルタイムを取得する処理
Private Function GetFileTime(ByVal reSetting As Date) As FILETIME
    Dim tSystemTime As SYSTEMTIME

    With tSystemTime
        .Year = Year(reSetting)
        .Month = Month(reSetting)
        .DayOfWeek = Weekday(reSetting)
        .Day = Day(reSetting)
        .Hour = Hour(reSetting)
        .Minute = Minute(reSetting)
        .Second = Second(reSetting)
    End With
    Dim tLocalTime As FILETIME
    Call SystemTimeToFileTime(tSystemTime, tLocalTime)

    Dim tFileTime As FILETIME
    Call LocalFileTimeToFileTime(tLocalTime, tFileTime)

    GetFileTime = tFileTime
End Function
'ファイルのハンドルを取得
Private Function GetFileHandle(ByVal strFilePath As String) As Long
    GetFileHandle = CreateFile( _
        strFilePath, GENERIC_READ Or GENERIC_WRITE, _
        FILE_SHARE_READ, 0, OPEN_EXISTING, _
        FILE_ATTRIBUTE_NORMAL, 0 _
        )
End Function
'ファイルの指定タイムスタンプを指定日時に設定する処理
Private Sub reSetFileTime(ByVal strFilePath As String, _
                            ByVal d1 As Date, _
                            ByVal d2 As Date, _
                            ByVal d3 As Date)
    
    Dim i1 As Long, i2 As Long, i3 As Long
    Dim lngCase As Long
    Dim d1FileTime As FILETIME
    Dim d2FileTime As FILETIME
    Dim d3FileTime As FILETIME
    Dim cFileHandle As Long
    
    'ファイルタイムを取得する
    If d1 <> 0 Then d1FileTime = GetFileTime(d1): i1 = 1 Else i1 = 0
    If d2 <> 0 Then d2FileTime = GetFileTime(d2): i2 = 1 Else i2 = 0
    If d3 <> 0 Then d3FileTime = GetFileTime(d3): i3 = 1 Else i3 = 0
    lngCase = i1 & i2 & i3
    
    'ファイルのハンドルを取得する
    cFileHandle = GetFileHandle(strFilePath)
    
    'ファイルのハンドルが取得できた場合のみ「更新日時」を更新する
    If cFileHandle >= 0 Then
        Dim tNull As FILETIME
        Select Case lngCase
            Case 100  '作成日時のみ
                Call SetFileTime(cFileHandle, d1FileTime, tNull, tNull)
            Case 10    '更新日時のみ
                Call SetFileTime(cFileHandle, tNull, d2FileTime, tNull)
            Case 1    'アクセス日時のみ
                Call SetFileTime(cFileHandle, tNull, tNull, d3FileTime)
            Case 111  'すべての日時
                Call SetFileTime(cFileHandle, d1FileTime, d2FileTime, d3FileTime)
            Case 110  '作成日時と更新日時
                Call SetFileTime(cFileHandle, d1FileTime, d2FileTime, tNull)
            Case 11   '更新日時とアクセス日時
                Call SetFileTime(cFileHandle, tNull, d2FileTime, d3FileTime)
        End Select
        
        Call CloseHandle(cFileHandle)
    
    End If
End Sub

一括変更を実行するコード

「選択して変更実行」ボタンで実行させます

'ファイルのタイムスタンプを一括で変更する処理
Sub TimeStmpChange()
    Dim OpenFileName As Variant
    Dim fileName As String
    Dim selectFileName As Variant
    Dim d1 As Date, d2 As Date, d3 As Date
    Dim pos As Long, i As Long
    
    'ファイル選択ダイアログを表示
    selectFileName = _
        Application.GetOpenFilename( _
            FileFilter:="全てのファイル,*.*,Microsoft Excel,*.xls?", _
            FilterIndex:=1, _
            Title:="ファイルを選択してください（複数可）", _
            MultiSelect:=True)
    '選択されたファイルに対する処理
    If IsArray(selectFileName) Then
        On Error GoTo ErrHandler
        'タイムスタンプを変更する種類の判別（flg = i)
        If Cells(3, 5) <> "" Then d1 = Cells(3, 5) Else: d1 = 0
        If Cells(3, 6) <> "" Then d2 = Cells(3, 6) Else: d2 = 0
        If Cells(3, 7) <> "" Then d3 = Cells(3, 7) Else: d3 = 0
        
        i = d1 + d2 + d3
        If i = 0 Then
            MsgBox ("タイムスタンプが指定されていないので終了します！")
            Exit Sub
        End If
        '全てのファイルに繰り返し処理を行う
        For Each OpenFileName In selectFileName
            pos = InStrRev(OpenFileName, "\")
            fileName = Mid(OpenFileName, pos + 1)
            
            'タイムスタンプをを変更する処理へ
            Call reSetFileTime(OpenFileName, d1, d2, d3)
        Next
    Else
        MsgBox ("ファイルを選択しないで終了！")
        Exit Sub
    End If
    MsgBox "選択したファイルのタイムスタンプ変更が終了しました", _
            vbOKOnly + vbInformation, "タイムスタンプ一括変更"
    Exit Sub

ErrHandler:
    MsgBox "「" & fileName & "」の処理中にエラーが発生しました" & _
    vbCrLf & Err.Description, vbExclamation, "タイムスタンプ一括変更"
    
End Sub

個別ファイルごとに変更を実行するコード

「表示中の設定に変更を実行」ボタンで起動するコードです

'セルに表示されているファイルのタイムスタンプを一括で変更する処理
Sub SheetSetTimeStmpChange()
    Dim OpenFileName As Variant
    Dim selectFileName As Variant
    Dim d1 As Date, d2 As Date, d3 As Date
    Dim i As Long
    Dim n As Long, k As Long
    Dim allflg As Long
    
    'セルに表示されているファイルに対する処理
    n = Cells(Rows.Count, 4).End(xlUp).Row
    If n < 4 Then MsgBox ("ファイルの指定がありません！"): Exit Sub
    If Cells(1, 5) = "" Then MsgBox ("フォルダの指定がありません！"): Exit Sub
    On Error GoTo ErrHandler
    For k = 4 To n
        If allflg = 1 Then GoTo all　'一括変更だった場合処理をジャンプします
        If Cells(3, 5) <> "" Then d1 = Cells(3, 5) Else: d1 = 0
        If Cells(3, 6) <> "" Then d2 = Cells(3, 6) Else: d2 = 0
        If Cells(3, 7) <> "" Then d3 = Cells(3, 7) Else: d3 = 0
        i = d1 + d2 + d3
        If i <> 0 Then allflg = 1: GoTo all　'一括変更だった場合Flgセット
        
        'タイムスタンプを変更する種類の判別（flg = i)
        If Cells(k, 5) <> "" Then d1 = Cells(k, 5) Else: d1 = 0
        If Cells(k, 6) <> "" Then d2 = Cells(k, 6) Else: d2 = 0
        If Cells(k, 7) <> "" Then d3 = Cells(k, 7) Else: d3 = 0
        i = d1 + d2 + d3
        If i = 0 Then GoTo tugi
all:
        OpenFileName = Cells(1, 5) & "\" & Cells(k, 4)
        'タイムスタンプをを変更する処理へ
        Call reSetFileTime(OpenFileName, d1, d2, d3)
tugi:
    Next
    MsgBox "指定ファイルのタイムスタンプ変更が終了しました", _
            vbOKOnly + vbInformation, "タイムスタンプ一括変更"
    Exit Sub

ErrHandler:
    MsgBox "「" & Cells(k, 4) & "」の処理中にエラーが発生しました" & _
    vbCrLf & Err.Description, vbExclamation, "タイムスタンプ一括変更"
    
End Sub

・各コードの細かい説明は省略します
・コード内のコメント記述で確認してください
・「作成」「更新」「アクセス」の設定を確認して処理方法を変更しています

まとめ（おわりに）

注意事項の確認と感想など

・実行前に必ずコピーを取っておくようにしてください
・現ファイルのタイムスタンプの確認を行い、取得できたセルデータを保存しておけば
・万一の場合は、そのデータから元通りに復元することが可能ですのでご利用ください

・前回記事ではパスワード変更時にタイムスタンプを変更しなかったのは「更新日時」
　だけでしたが、今回の記事で「すべて」変更できるようになりました
・しかも、指定日時への変更が可能となっていますので有効活用できます
・というわけですので、くれぐれも注意して使用してください。悪用はしないでね(^^;

今後の記事について

今回の記事はいかがだったでしょうか。お役に立てたなら幸いです(^^;
是非！サンプルがありますので使ってみてください(^^)/

【今後の記事内容はどうしようかなぁ・・・】
・ZIPファイルの作成方法と活用法など
・高速化した「VlookUp関数」のVBAでの活用法を再検討してみたいと思います
・その他「小ネタ」などなど・・・・・
・今後これらのどれかについて記事にしていきたいと思います。ご期待ください(^^)/