指定したフォルダ内の全ファイルの更新日時を変更する(VBA)
最近はVBAから少し離れていたこともあり久しぶりの更新です。
(1年以上の空白期間...)
さて、最近私は大量のファイルを整理する役目を担っております。
その中で更新日時を指定の日付に変更するというものがありまして
100以上のファイルがあるのでさすがに一つ一つやるというのは無理でして、、
VBAでスクリプトを組んでみました。
本スクリプトを動作させるには参照設定に追加のチェックが必要です。(本当はなしでやりたかったけどなぜかできなかった。)
Option Explicit ' 参照設定をオンにすること(以下の2項目) ' Microsoft Scripting Runtime ' Microsoft Shell Controls And Automation ' グローバル変数 Dim fcount As Long Public Sub main() ' カウンタ変数初期化 fcount = 0 ' ダイアログでフォルダを選択する With Application.FileDialog(msoFileDialogFolderPicker) If .Show = True Then SubFolderPick (CStr(.SelectedItems(1))) MsgBox "処理終了" & vbLf & "処理ファイル数:" & fcount End If End With End Sub ' すべてのサブフォルダに対して処理を実行(引数:フォルダ名(文字列)) Private Sub SubFolderPick(fpath As String) Dim fso As New Scripting.FileSystemObject Dim fol As Scripting.Folder 'まずは親フォルダにのファイルに処理を実行 changeKoshin (fpath) 'フォルダ内のすべてのサブフォルダをループ For Each fol In fso.GetFolder(fpath).SubFolders 'サブフォルダに対して処理を実行 changeKoshin (CStr(fol)) ' 再帰呼び出し(サブフォルダのサブフォルダで実行) SubFolderPick (CStr(fol)) Next End Sub ' フォルダ内すべてファイルの更新日時を更新する処理(引数:フォルダ名(文字列)) Private Sub changeKoshin(fpath As String) Dim fso As New Scripting.FileSystemObject Dim shell As New Shell32.shell Dim files As Scripting.files Dim file As Scripting.file Dim folder_o As Shell32.Folder Dim file_o As Shell32.FolderItem ' フォルダ内のファイルたちを取得 Set files = fso.GetFolder(fpath).files ' フォルダを取得(shell) Set folder_o = shell.Namespace(fpath) ' フォルダ内の全ファイルに対して For Each file In files Set file_o = folder_o.ParseName(file.Name) 'ファイルを取得 file_o.ModifyDate = Now '更新日時を今に変更 Next '処理したファイル数を加算 fcount = fcount + files.Count ' 後処理 Set files = Nothing Set fso = Nothing Set shell = Nothing Set folder_o = Nothing Set file_o = Nothing End Sub
Excelでマクロ(main)を実行するとフォルダ選択ウィンドウが現れます。
選択したフォルダ内にあるすべてのファイルの更新日時が現在時刻に変更されます。
ちなみに、サブフォルダ内にあるファイルもすべて変更が適用されます。