【Excel VBA】ファイル情報 [ファイル名、更新日時、作成日時等] の一括変更ツール(コピペですぐ使える)

日常業務を行うにあたって、定例作業でたくさんのファイルの名称を変更することもあるかと思います。

 

その際に一つずつファイルを選択してF2を押してファイル名を変更して、ファイルを選択してファイル名を変更して、、、と何度も同じ作業の繰り返しになってしまっては非常に時間がもったいないです。そのため、一度に大量のファイル情報を変更できるツール『ファイル情報の一括変更ツール』をExcelマクロで作成しました。

 

これを使用すれば定例業務の業務効率化が図れるかと思いますので、是非ご活用頂けたらと思います。

 

なお、ファイルの作成日時や更新日時を変更することはトラブルの元になる可能性もあるため、作成日時等の変更に関しては自己責任でご使用ください。

 

ボタンについての詳しい記事は以下を参照ください。

 

<ツールの更新履歴>

(2022年7月10日:更新) 軽微な不具合の修正、「①対象のファイルを指定」と「②ファイル情報等を変更」の処理を実施する図形をボタン形式に変更しました。

 

『ファイル情報の一括変更ツール』の概要

以下の手順で当ツールを活用できます。

  1. 当ツールであるExcelファイル内から対象のファイルをダイアログから選択します。
  2. 選択したファイルに対して、変更したいファイルのファイル名/作成日時/更新日時/アクセス日時をそれぞれ入力します。
  3. ボタンをクリックし変更を実行すると、入力したファイルにおけるファイル名、OSのファイル作成日時/更新日時/アクセス日時が変更されます。

使用方法の詳細は以下で説明していきます。

 

当ツールの使用方法

基本的な機能、操作方法の説明

1.ファイル情報の一括変更ツールのマクロが入ったExcelファイル(***.xlsm)を開きます。

 

2.「① 対象のファイルを指定」ボタンをクリックします。

 

3.ファイル選択ダイアログにてファイル名称等を変えたいファイル(複数選択可)を選択して、「開く」をクリックします。

選択したファイルの情報(ファイル名、作成日時、更新日時、アクセス日時)が表示されます。

 

4.表示されたファイル名、作成日時、更新日時、アクセス日時に対して、変更したい項目の値を変更し、「② ファイル名称等の情報を変更」ボタンをクリックします。

 

指定したファイルのファイル名/作成日時/更新日時/アクセス日時が入力した値で変更されました。

留意事項

当マクロを使用するにあたって、以下の留意する点がありますので、確認してください。

 

ショートカットファイル(*.lnk)は選択できません。

ショートカットファイルはショートカット先のファイルが選択された状態になるので、指定しないでください。

 

ファイル名称を変更する場合は、拡張子も含んだ名称を入力してください。

ファイル名を入力する場合は、名称だけでなく拡張子も含んだ値で変更されるため、必要に応じて拡張子を忘れずに入れてください

例)テキストファイルの場合は「XXX.txt」、Excelファイルの場合は「ZZZ.xlsx」と指定してください。

 

使用する際の事前準備

このページの下部にある「Excelファイルのツール」からExcelファイルを取得し、「準備の手順」内にあるVBAコードを取得したExcelファイルに記載して保存すれば、すぐに当ツールを使用できます。

 

以下にその手順を説明していきます。

 

準備の手順

1.ツールのダウンロードはこちら」からサンプル(Excelファイル)をダウンロードします。

※インターネットにあるマクロファイルをダウンロードすることはセキュリティ上リスクがあるので、クロ無しExcelファイルを公開しています

 

2.ダウンロードしたExcelファイルの上部にあるリボンの「開発」タブから「visual basic」を選択して、VBE(visual basic for application)を起動させます。

 

リボンに「開発」タブが表示されていない場合は、以下を参照ください

 

3.「プロジェクト」に「標準モジュール」を追加して、追加された「Module1」にVBAコードを記載します。

 

VBAのソースコードはこちら

以下のVBAコードをコピーして、「Module1」内のエディターに貼り付けます。

※VBAコードの右上のアイコンをクリックするとソースコードをコピーできます

Option Explicit

'---------(設定値)---------------------------
Private Const START_DATA_ROW = 9                    '1.テーブル見出し行の行番号
Private Const START_DATA_COL_NUM = 1                '2.テーブル見出し列の列番号
Private Const START_AFTER_COL_NUM = 5               '3.変更後データ部の開始列番号
Private Const FOLDER_PATH_POINT = "B5"              '4.選択したファイル等があるフォルダーのセル位置
Private Const FORMAT_DATE = "yyyy/mm/dd hh:mm:ss"   '5.日付フォーマットの形式
    
'パワーシェルのコマンド用
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
    
    'ボタンを押した演出をする
    ActiveSheet.Shapes("対象のファイルを指定").Visible = False
    
    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
        
        'ボタンを戻す演出をする
        ActiveSheet.Shapes("対象のファイルを指定").Visible = True
        
        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%)
        
    'ボタンを戻す演出をする
    ActiveSheet.Shapes("対象のファイルを指定").Visible = True
    
    Exit Sub
err:
    MsgBox Emsg2
    
    'ボタンを戻す演出をする
    ActiveSheet.Shapes("ファイル情報等を変更").Visible = True
    
    'ボタンを戻す演出をする
    ActiveSheet.Shapes("対象のファイルを指定").Visible = True
    
End Sub

'===========================================
'②ファイル名称等を変更する際の処理
'===========================================
Sub ファイル名称等の変更実行_Click()
    
    On Error GoTo err
    
    Set BaseBook = ActiveWorkbook
    Set BaseSheet = ActiveSheet
    
    'ボタンを押し込む演出をする
    ActiveSheet.Shapes("ファイル情報等を変更").Visible = False
    
    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
        
        'ボタンを戻す演出をする
        ActiveSheet.Shapes("ファイル情報等を変更").Visible = True
        
        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
    
    'ボタンを戻す演出をする
    ActiveSheet.Shapes("ファイル情報等を変更").Visible = True
    
    Exit Sub
    
err:
    MsgBox Emsg2
    
    'ボタンを戻す演出をする
    ActiveSheet.Shapes("ファイル情報等を変更").Visible = True
    
    'ボタンを戻す演出をする
    ActiveSheet.Shapes("対象のファイルを指定").Visible = True
    
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

 

5.ファイルを保存する際は「Excelマクロ有効ブック」を選択して、保存します。

 

6.① 対象のファイルを指定(ダイアログが起動)」ボタンにメイン処理「対象のファイルを指定_Click」のマクロを設定します。

 

7.② ファイル名称等の情報を変更」ボタンにメイン処理「フォルダーファイル名称等の変更実行_Click」のマクロを設定します。

それぞれのボタン上にカーソルを置くと指アイコンになっていれば正常にマクロが設定できています。

 

これで事前準備は完了です。

あとは「当ツールの使用方法」で記載された方法でツールを実行できます。

 

また、このようなExcelVBAを用いた業務効率化を行うときに、以下の書籍が初心者向けでとても参考になると思いますので、良かったらご参照ください。

 

なお、当ツールの開発環境として、OSは “Windows10” 、Excelのバージョンは “Microsoft Office 365″ で行っており、当環境では動作確認ができていますが、他のすべての環境で正常に動作するかは確認できていません。

 

正常に動作しない場合は、コメントいただければ幸いです。
 

また、このような業務効率化できるツールを以下に一覧でまとめてありますので、ご興味のある方はご覧ください。

 

当ツールのダウンロードはこちら

下記よりExcelファイルをダウンロードして、記事の途中にありました VBAのソースコード をツール内に組み込んで使用してください。

 

【Excel VBA】ファイル情報の一括変更ツール

※インターネットにあるマクロファイルをダウンロードすることはセキュリティ上リスクがあるので、マクロ無しExcelファイルを公開しています

 

他に要望等ありましたら、可能な限り改修等を対応しますのでコメント頂ければと思います

 

<このツールが『結構使える!』と思ったら、下のグッドボタンを押していただけたら幸いです>

コメントを残す

CAPTCHA