ファイルの更新日時を変更する

ちょっと調べてみた。すると、

www.tipsfound.com

コチラがヒット。曰く、

ファイルに日時を設定

FileSystemObject や VBA の標準機能には日時を変更する機能はありません。代わりに Shell.Application を使って更新日時の変更ができます。それ以外の作成日時などは変更できません。
Dim shell As Object
Set shell = CreateObject("Shell.Application") ' インスタンス化'

Dim fl As Object
Set fl = shell.Namespace("D:\")  ' フォルダを取得'  '"

Dim f As Object
Set f = fl.ParseName("Tips.txt") ' フォルダ内のファイルを取得'

f.ModifyDate = Now ' 更新日時を変更'

' 後始末'
Set f = Nothing
Set fl = Nothing
Set shell = Nothing
Tipsfound > Excel VBA > ファイルの日時の取得または変更より

とのこと。

必要なこと

ファイルの更新日時を変更するためには、

Shellオブジェクトを取得する
ShellオブジェクトのNameSpaceメソッドを用いてFolderオブジェクトを取得する
FolderオブジェクトのParseNameメソッドを用いてFolderItemオブジェクトを取得する
FolderItemオブジェクトのModifyDateプロパティに日付時刻の値をセットする

以上、これだけのステップが必要っぽい。

ちなみに、↑で「Folderオブジェクト」とあるのは、FileSystemObjectでおなじみのScriptingライブラリのFolderオブジェクトではなく、Shell32ライブラリのFolderオブジェクトなので注意。

とりあえず、これだけわかっていたらコーディング可能。

コーディング

上掲のサンプルコードでは、Shellオブジェクトのインスタンスを得るのにCreateObjectを用いていたが、New演算子好き（笑）としては、ライブラリの参照設定をしておくことにする。

「ツール」→「参照設定」へと進んで、Microsoft Scripting Runtime、及びMicrosoft Shell Controll And Automationを参照設定しておく。

f:id:akashi_keirin:20191014072429j:plain

画像の下二つ。

リスト１　標準モジュール

Private fsObj As New Scripting.FileSystemObject
Private shellObj As New Shell32.Shell

Public Function setLastModifiedDateTime( _
            ByVal tgtFilePath As String, _
            ByVal tgtDateTime As Date) As Boolean  '……(1)'
  setLastModifiedDateTime = False
  On Error GoTo ErrorHandler  '……(2)'
  'Scripting.Fileオブジェクトを取得'
  Dim tgtFile As Scripting.File  '……(3)'
  Set tgtFile = fsObj.GetFile(tgtFilePath)
  'フォルダパスを取得'
  Dim folderPath As String  '……(4)'
  folderPath = tgtFile.ParentFolder.Path
  'フォルダを取得'
  Dim tgtFolder As Shell32.Folder  '……(5)'
  Set tgtFolder = shellObj.Namespace(folderPath)
  'ファイルを取得'
  Dim tgtItem As Shell32.FolderItem  '……(6)'
  Set tgtItem = tgtFolder.ParseName(tgtFile.Name)
  '更新日時をセット'
  tgtItem.ModifyDate = tgtDateTime  '……(7)'
  setLastModifiedDateTime = True
  Exit Function
ErrorHandler:  '……(8)'
  Call Err.Clear
End Function

(1)の

Public Function setLastModifiedDateTime( _
            ByVal tgtFilePath As String, _
            ByVal tgtDateTime As Date) As Boolean

で引数と返り値の設定。

第１引数tgtFilePathは、更新日時を変えたいファイルのフルパス。

第２引数tgtDateTimeは、新規にセットする更新日時の値。

途中でエラーが出るなど、更新日時のセットに失敗したときにFalseを返すBoolean型メソッドにした。

(2)の

On Error GoTo ErrorHandler

で、途中エラーが生じたら一番下まで飛んでExitし、Falseを返すようにした。

ここからが処理の本体。(3)の

Dim tgtFile As Scripting.File
Set tgtFile = fsObj.GetFile(tgtFilePath)

ではFileSystemObjectのGetFileメソッドを用いてFileオブジェクトを取得。

第１引数でファイルのフルパスを受け取っているので、それを使う。

後ほど、当該のファイルがあるフォルダパスとファイル名とが必要になるのだが、両方ともFileオブジェクトから取得可能なので、こうしている。

まず、当該ファイルがあるフォルダパスは、(4)の

Dim folderPath As String
folderPath = tgtFile.ParentFolder.Path

で取得。

FileオブジェクトのParentFolderプロパティを参照すればScripting.Folderオブジェクトが取得できるので、そのPathプロパティを参照してフォルダパス（文字列の値）を得る。

次に、先ほど得たフォルダパス文字列を用いて、(5)の

Dim tgtFolder As Shell32.Folder
Set tgtFolder = shellObj.Namespace(folderPath)

でShell32.Folderオブジェクトを取得。

既述のとおり、このFolderオブジェクトはShell32ライブラリのFolderオブジェクト。

ShellオブジェクトのNameSpaceメソッドにフォルダフルパスを渡してやれば、Shell32.Folderオブジェクトが取得できるので、そいつをShell32.Folder型の変数tgtFolderにぶち込む。

今度は、先ほど取得したShell32.Folderオブジェクトと、当該のファイルのファイル名を用いて(6)の

Dim tgtItem As Shell32.FolderItem
Set tgtItem = tgtFolder.ParseName(tgtFile.Name)

でShell32.FolderItemオブジェクトを得る。

Shell32.FolderオブジェクトのParseNameメソッドに当該ファイルのファイル名を渡せばよい。

ファイル名は、Scripting.FileオブジェクトのNameプロパティを参照すれば取得できる。

取得したShell32.FolderItemオブジェクトは、Shell32.FolderItem型の変数tgtItemにぶち込む。

これでリーチ！

あとは、(7)の

tgtItem.ModifyDate = tgtDateTime
setLastModifiedDateTime = True

でShell32.FolderItemオブジェクトのModifyDateプロパティに日付時刻をセットして、返り値をTrueにしておしまい。

(8)の

ErrorHandler:
  Call Err.Clear

は、エラーが出たとき用。ErrオブジェクトのClearメソッドでエラーをクリア。必要なのかどうかは知らん。

使ってみる

このプロジェクトがあるフォルダに、

f:id:akashi_keirin:20191014072432j:plain

このように、「ち～んｗ.txt」というファイルを用意。

更新日時は2019/10/13 21:15となっている。

この状態で次のコードを実行。

リスト２　標準モジュール

Private Sub TestSetLastModifiedDateTime()
  Dim tgtFilePath As String
  tgtFilePath = ThisWorkbook.Path & "\ち～んｗ.txt"
  Dim tgtDate As Date
  tgtDate = "2019/10/14 05:30:00"
  If setLastModifiedDateTime( _
           tgtFilePath, _
           tgtDate) Then
    Call MsgBox("Set LastModifiedDateTime to " & """" & CStr(tgtDate) & """, " & _
                "and disguise has succeeded!")
  Else
    Call MsgBox("It has failed to disguise LastModifiedDateTime...")
  End If
End Sub

先ほどの「ち～んｗ.txt」の更新日時を2019/10/14 05:30:00に変更し、変更の成否に応じてメッセージボックスを表示するという処理にした。

メッセージボックスの表示の英語はテキトー。英語が得意な人、添削しろしてください。