日常業務を行うにあたって、定例作業でたくさんのファイルの名称を変更することもあるかと思います。
その際に一つずつファイルを選択してF2を押してファイル名を変更して、ファイルを選択してファイル名を変更して、、、と何度も同じ作業の繰り返しになってしまっては非常に時間がもったいないです。
そのため、一度に大量のファイル情報を変更できるツール『ファイル情報の一括変更ツール』をExcelマクロで作成しました。
これを使用すれば定例業務の業務効率化が図れるかと思いますので、是非ご活用頂けたらと思います。
なお、ファイルの作成日時や更新日時を変更することはトラブルの元になる可能性もあるため、作成日時等の変更に関しては自己責任でご使用ください。
（2022年7月10日：更新）
・軽微な不具合の修正、「①対象のファイルを指定」と「②ファイル情報等を変更」の処理を実施する図形をボタン形式に変更しました。
（2023年1月17日：更新）
・全体的なUIを変更しました。
『ファイル情報の一括変更ツール』の概要
以下の手順で当ツールを活用できます。
- 当ツールであるExcelファイル内から対象のファイルをダイアログから選択します。
- 選択したファイルに対して、変更したいファイルのファイル名/作成日時/更新日時/アクセス日時をそれぞれ入力します。
- ボタンをクリックし変更を実行すると、入力したファイルにおけるファイル名、OSのファイル作成日時/更新日時/アクセス日時が変更されます。
使用方法の詳細は以下で説明していきます。
当ツールの使用方法
基本的な機能、操作方法の説明
１．ファイル情報の一括変更ツールのマクロが入ったExcelファイル（***.xlsm）を開きます。
２．「① 対象のファイルを指定」ボタンをクリックします。
３．ファイル選択ダイアログにてファイル名称等を変えたいファイル（複数選択可）を選択して、「開く」をクリックします。
選択したファイルの情報（ファイル名、作成日時、更新日時、アクセス日時）が表示されます。
４．表示されたファイル名、作成日時、更新日時、アクセス日時に対して、変更したい項目の値を変更し、「② ファイル情報等を変更」ボタンをクリックします。
指定したファイルのファイル名/作成日時/更新日時/アクセス日時が入力した値で変更されました。
留意事項
当マクロを使用するにあたって、以下の留意する点がありますので、確認してください。
ショートカットファイル（*.lnk）は選択できません。
ショートカットファイルはショートカット先のファイルが選択された状態になるので、指定しないでください。
ファイル名称を変更する場合は、拡張子も含んだ名称を入力してください。
ファイル名を入力する場合は、名称だけでなく拡張子も含んだ値で変更されるため、必要に応じて拡張子を忘れずに入れてください。
例）テキストファイルの場合は「XXX.txt」、Excelファイルの場合は「ZZZ.xlsx」と指定してください。
使用する際の事前準備
このページの下部にある「Excelファイルのツール」からExcelファイルを取得し、「準備の手順」内にあるVBAコードを取得したExcelファイルに記載して保存すれば、すぐに当ツールを使用できます。
以下にその手順を説明していきます。
準備の手順
１．「ツールのダウンロードはこちら」からサンプル（Excelファイル）をダウンロードします。
※インターネットにあるマクロファイルをダウンロードすることはセキュリティ上リスクがあるので、クロ無しExcelファイルを公開しています
２．ダウンロードしたExcelファイルの上部にあるリボンの「開発」タブから「visual basic」を選択して、VBE（visual basic for application）を起動させます。
リボンに「開発」タブが表示されていない場合は、以下を参照ください
（参考サイト：記事「Excel VBAを始める前に、最初にやっておくべき初期設定内容はこれ」の『開発』タブを表示させる）
３．「プロジェクト」に「標準モジュール」を追加して、追加された「Module1」にVBAコードを記載します。
VBAのソースコードはこちら
以下のVBAコードをコピーして、「Module1」内のエディターに貼り付けます。
※VBAコードの右上のアイコンをクリックするとソースコードをコピーできます
Option Explicit
'---------（設定値）---------------------------
Private Const START_DATA_ROW = 9 '１．テーブル見出し行の行番号
Private Const START_DATA_COL_NUM = 2 '２．テーブル見出し列の列番号
Private Const START_AFTER_COL_NUM = 6 '３．変更後データ部の開始列番号
Private Const FOLDER_PATH_POINT = "C5" '４．選択したファイル等があるフォルダーのセル位置
Private Const FORMAT_DATE = "yyyy/mm/dd hh:mm:ss" '５．日付フォーマットの形式
'パワーシェルのコマンド用
Private Const PSHELL_CMD1 = "Set-ItemProperty "
Private Const PSHELL_CMD2 = " -name "
Private Const PSHELL_CMD3 = "-value "
Private Const PSHELL_CMD_CREATE = "CreationTime "
Private Const PSHELL_CMD_UPDATE = "LastWriteTime "
Private Const PSHELL_CMD_ACCESS = "LastAccessTime "
'---------（メッセージ）-----------------------
Private Const Msg1 = "ファイル情報等を変更する対象ファイル（複数選択可）を選択してください。"
Private Const Msg2 = "ファイル情報等の変更が正常に終了しました。"
Private Const Wmsg1 = "ショートカットファイル（*.lnk）は対象外です。" & vbCrLf & "ショートカットファイルを選択しないでください。"
Private Const Emsg1 = "赤色箇所は更新できていません。" & vbCrLf & "日付欄は yyyy/mm/dd hh:mm 形式で設定してください。"
Private Const Emsg2 = "予期せぬエラーが発生しました。"
'----------------------------------------------
Dim BaseBook As Workbook
Dim BaseSheet As Worksheet
Dim ErrMsg As String
'===========================================
'①対象のファイルを指定する際の処理
'===========================================
Sub 対象のファイルを指定_Click()
On Error GoTo err
Application.ScreenUpdating = True
Application.EnableEvents = True
Set BaseBook = ActiveWorkbook
Set BaseSheet = ActiveSheet
'初期処理（表内のデータを削除して罫線、色をリセットする）
Call initialize
Dim row As Long: row = START_DATA_ROW
Dim filePathArr As Variant
Dim filePath As Variant
Dim beforeFilePath As String
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Dim f As Object
'ダイアログの表示処理
filePathArr = Application.GetOpenFilename(Filefilter:="すべてのファイル (*.*),*.*", Title:=Msg1, MultiSelect:=True)
If IsArray(filePathArr) Then
'取得したファイル数分だけ処理を繰り返す
For Each filePath In filePathArr
'ファイル情報を取得する
Set f = fso.GetFile(filePath)
'他ファイルとパスが異なる場合はショートカットファイルを選択したとみなして処理を終了させる
If beforeFilePath <> "" And beforeFilePath <> f.ParentFolder.Path Then
MsgBox Wmsg1
Call initialize
Exit Sub
End If
beforeFilePath = f.ParentFolder.Path
BaseSheet.Cells(row, START_DATA_COL_NUM).value = f.Name 'ファイル名
BaseSheet.Cells(row, START_DATA_COL_NUM + 1).value = Format(f.DateCreated, FORMAT_DATE) '作成日時
BaseSheet.Cells(row, START_DATA_COL_NUM + 2).value = Format(f.DateLastModified, FORMAT_DATE) '更新日時
BaseSheet.Cells(row, START_DATA_COL_NUM + 3).value = Format(f.DateLastAccessed, FORMAT_DATE) 'アクセス日時
'指定したファイルが存在するフォルダを表示する
BaseSheet.Range(FOLDER_PATH_POINT).value = f.ParentFolder.Path
row = row + 1
Next filePath
'キャンセルが選択された場合はダイアログを閉じる
Else
Exit Sub
End If
'表の最終行番号を取得する
Dim endRow As Long, endCol As Long
endRow = BaseSheet.Cells.Find(What:="*", LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).row
endCol = BaseSheet.Cells.Find(What:="*", LookIn:=xlFormulas, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).column
Dim bs As Borders
Set bs = BaseSheet.Range(BaseSheet.Cells(START_DATA_ROW, START_DATA_COL_NUM), BaseSheet.Cells(endRow, endCol)).Borders
bs.LineStyle = xlContinuous '上下左右の罫線を引く
bs.ColorIndex = 15 '罫線の色：灰色
BaseSheet.Range(BaseSheet.Cells(START_DATA_ROW, START_DATA_COL_NUM), BaseSheet.Cells(endRow, START_DATA_COL_NUM + 3)).Interior.Color = RGB(217, 217, 217) '背景色：薄い灰色（基本色15％）
Exit Sub
err:
MsgBox Emsg2
End Sub
'===========================================
'②ファイル名称等を変更する際の処理
'===========================================
Sub ファイル名称等の変更実行_Click()
On Error GoTo err
Set BaseBook = ActiveWorkbook
Set BaseSheet = ActiveSheet
Application.ScreenUpdating = True
Application.EnableEvents = True
ErrMsg = ""
Dim baseFilePath As Variant
Dim beforeFileName As String
Dim i As Long
Dim afterFileName As String
Dim afterCreateDate As String
Dim afterUpdateDate As String
Dim afterAccessDate As String
If BaseSheet.Cells(START_DATA_ROW, START_DATA_COL_NUM).value = "" Then
MsgBox Msg1
Exit Sub
End If
'表の最終行番号を取得する
Dim endRow As Long, endCol As Long
endRow = BaseSheet.Cells.Find(What:="*", LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).row
endCol = BaseSheet.Cells.Find(What:="*", LookIn:=xlFormulas, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).column
Dim shell As Object
Set shell = CreateObject("Shell.Application")
Dim fl As Object, f As Object
For i = START_DATA_ROW To endRow
afterFileName = BaseSheet.Cells(i, START_AFTER_COL_NUM).value
afterCreateDate = isDateCheck(BaseSheet.Cells(i, START_AFTER_COL_NUM + 1).value, i, START_AFTER_COL_NUM + 1)
afterUpdateDate = isDateCheck(BaseSheet.Cells(i, START_AFTER_COL_NUM + 2).value, i, START_AFTER_COL_NUM + 2)
afterAccessDate = isDateCheck(BaseSheet.Cells(i, START_AFTER_COL_NUM + 3).value, i, START_AFTER_COL_NUM + 3)
beforeFileName = BaseSheet.Cells(i, START_DATA_COL_NUM).value
baseFilePath = BaseSheet.Range(FOLDER_PATH_POINT).value
Set fl = shell.Namespace(baseFilePath) 'ファイルを取得
Set f = fl.ParseName(beforeFileName) 'フォルダ内のファイルを取得
If afterFileName <> "" And f.Name <> afterFileName Then
f.Name = afterFileName 'ファイル/フォルダ名称を変更
BaseSheet.Cells(i, START_DATA_COL_NUM).value = f.Name
BaseSheet.Cells(i, START_AFTER_COL_NUM).value = f.Name
End If
If afterCreateDate <> "" Then
updDate_Pshell (PSHELL_CMD1 & Chr(39) & f.Path & Chr(39) & PSHELL_CMD2 & PSHELL_CMD_CREATE & PSHELL_CMD3 & Chr(39) & afterCreateDate & Chr(39)) '作成日時を変更
BaseSheet.Cells(i, START_DATA_COL_NUM + 1).value = afterCreateDate
End If
If afterUpdateDate <> "" Then
updDate_Pshell (PSHELL_CMD1 & Chr(39) & f.Path & Chr(39) & PSHELL_CMD2 & PSHELL_CMD_UPDATE & PSHELL_CMD3 & Chr(39) & afterUpdateDate & Chr(39)) '更新日時を変更
BaseSheet.Cells(i, START_DATA_COL_NUM + 2).value = afterUpdateDate
End If
If afterAccessDate <> "" Then
updDate_Pshell (PSHELL_CMD1 & Chr(39) & f.Path & Chr(39) & PSHELL_CMD2 & PSHELL_CMD_ACCESS & PSHELL_CMD3 & Chr(39) & afterAccessDate & Chr(39)) 'アクセス日時を変更
BaseSheet.Cells(i, START_DATA_COL_NUM + 3).value = afterAccessDate
End If
Next
Set f = Nothing
Set fl = Nothing
Set shell = Nothing
If ErrMsg <> "" Then
MsgBox ErrMsg
Else
MsgBox Msg2
End If
Exit Sub
err:
MsgBox Emsg2
End Sub
'-------------------------------------
'初期処理を行う
'-------------------------------------
Sub initialize()
Dim endRange As Range
Set endRange = ActiveSheet.Cells(START_DATA_ROW, START_DATA_COL_NUM).SpecialCells(xlLastCell)
Range(FOLDER_PATH_POINT).ClearContents
Range(Cells(START_DATA_ROW, START_DATA_COL_NUM), Cells(endRange.row, endRange.column)).ClearContents 'セル内の値を削除する
Range(Cells(START_DATA_ROW, START_DATA_COL_NUM), Cells(endRange.row, endRange.column)).Interior.ColorIndex = 0 '背景色0番：塗りつぶしなし
Range(Cells(START_DATA_ROW, START_DATA_COL_NUM), Cells(endRange.row, endRange.column)).Borders.LineStyle = xlLineStyleNone '罫線をなくす
ErrMsg = ""
End Sub
'-------------------------------------
'入力された値が正しいかチェックする
'-------------------------------------
Function isDateCheck(value As String, row As Long, column As Long)
If value = "" Then
isDateCheck = ""
Exit Function
End If
If IsDate(value) Then
ActiveSheet.Cells(row, column).Font.ColorIndex = 1 '文字色：黒
isDateCheck = Format(value, FORMAT_DATE)
Else
ActiveSheet.Cells(row, column).Font.ColorIndex = 3 '文字色：赤
If ErrMsg = "" Then ErrMsg = Emsg1
isDateCheck = ""
End If
End Function
'-------------------------------------
'パワーシェルを使用して、作成日時/更新日時/アクセス日時を変更する
'-------------------------------------
Function updDate_Pshell(psCmd As String)
Dim objWSH As Object
Set objWSH = CreateObject("WScript.Shell")
objWSH.Run "powershell -NoLogo -ExecutionPolicy RemoteSigned -Command " & psCmd, 0, True
End Function
５．ファイルを保存する際は「Excelマクロ有効ブック」を選択して、保存します。
６．「① 対象のファイルを指定（ダイアログが起動）」ボタンにメイン処理「対象のファイルを指定_Click」のマクロを設定します。
７．「② ファイル名称等の情報を変更」ボタンにメイン処理「ファイル情報等を変更_Click」のマクロを設定します。
それぞれのボタン上にカーソルを置くと指アイコンになっていれば正常にマクロが設定できています。
これで事前準備は完了です。
あとは「基本的な機能、操作方法の説明」で記載された方法でツールを実行できます。
なお、当マクロの開発環境は、OS：Windows10 、Excelソフトウェア：Microsoft Office 365となっており、当環境では動作確認ができていますが、他の環境で正常に動作するかは確認できていません。
正常に動作しない場合は、コメントいただければ幸いです。
また以下にて、このような業務効率化できるツールを機能ごとの一覧でまとめてますので、ご興味のある方はご覧ください。
自力で業務効率化できるツール等を作成する場合は、「オンラインITスクール」を利用するとモチベーションを保ちつつ、効率的に学習とアウトプットができると思います。
上記の「侍テラコヤ」は月額2,980円～ という日本最安級の料金でプログラミング学習ができ、今なら初めての方でも安心できる「1か月全額返金保証」があります。自分に合わないと感じた場合は返金してもらえるため、ノーリスクで試すことができます。是非一度体験してみることをオススメします ^ ^
ツールのダウンロードはこちら
下記よりExcelファイルをダウンロードして、記事の途中にありました VBAのソースコードをツール内に組み込んで使用してください。
【Excel VBA】ファイル情報の一括変更ツール
※インターネットにあるマクロファイルをダウンロードすることはセキュリティ上リスクがあるので、マクロ無しExcelファイルを公開しています
他に要望等ありましたら、可能な限り改修等を対応しますのでコメント頂ければと思います。
＜このツールが『結構使える！』と思ったら、下のグッドボタンを押していただけたら幸いです＞
こんなツールを作りたいと思っていました。
ありがとうございます。
JPEGファイルの撮影日時を変更することも可能でしょうか？
管理人RHです。
ムーミンパパさん、ツールのご使用とコメントありがとうございます。
JPEGファイルの撮影日時となると、写真のExif情報を修正することになるので当記事にあるソースコードの簡単な修正では対応できそうにありません。
また別記事で作成しますので、お待ちいただけると幸いです。
了解しました。
宜しくお願い致します。