EXCEL VBA フォルダ内の複数ファイルの一括リネームを効率化する。大量ファイルの一括リネームをスムーズに実行しよう！電子帳簿保存法に活用（テクニック）

EXCEL VBA フォルダ内の複数ファイルの一括リネームを効率化する。大量ファイルの一括リネームをスムーズに実行しよう！電子帳簿保存法に活用（テクニック）

Excel VBAを使った日々の作業の効率化と電子帳簿保存法に対応するファイル名自動生成方法

'
'
Option Explicit  ' 変数を明示的に宣言する必要があることを示す

Dim ws As Worksheet  ' ワークシートオブジェクト
Dim newRow, LastLow As Integer  ' newRowは新しい行、LastLowは最終行を示す
Dim folderPath As String  ' フォルダのパス

Sub RenameFiles01()  ' ファイル名の取得用サブルーチン
    Dim fd As FileDialog  ' ファイルダイアログオブジェクト
    Dim fileName As String  ' ファイル名を格納する変数
    Set ws = ThisWorkbook.Sheets("Sheet1")  ' "Sheet1"を作業シートとして設定
    newRow = 2  ' 新しい行を2行目から開始
    LastLow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row  ' B列の最終行を取得

    ' フォルダ選択ダイアログの設定
    Set fd = Application.FileDialog(msoFileDialogFolderPicker)
    If fd.Show = -1 Then  ' ダイアログが正常に表示された場合
        ws.Range("A2:E" & LastLow).ClearContents  ' A2:Eのセルをクリア
        
        folderPath = fd.SelectedItems(1)  ' 選択されたフォルダパスを取得
        fileName = Dir(folderPath & "\*.*")  ' フォルダ内の最初のファイル名を取得

        ' フォルダ内のファイル名とフルパスをExcelシートに表示
        Do While fileName <> ""
            ws.Cells(newRow, 1).Value = folderPath & "\" & fileName  ' フルパスをA列に
            ws.Cells(newRow, 2).Value = fileName  ' ファイル名をB列に
            fileName = Dir  ' 次のファイル名を取得
            newRow = newRow + 1  ' 行番号をインクリメント
        Loop
    End If
End Sub
'
'

Sub RenameFiles02()  ' ファイル名の変換用サブルーチン
    Dim i As Integer  ' ループカウンタ
    LastLow = ws.Cells(ws.Rows.Count, 2).End(xlUp).Row  ' B列の最終行を再計算
    Set ws = ThisWorkbook.Sheets("Sheet1")  ' "Sheet1"を再度設定
    For i = 2 To LastLow  ' 2行目から最終行までループ
        ' 3, 4, 5列が空でない場合に処理を実行
        If Not IsEmpty(ws.Cells(i, 3).Value) And Not IsEmpty(ws.Cells(i, 4).Value) And Not IsEmpty(ws.Cells(i, 5).Value) Then
            Dim oldFilePath As String  ' 旧ファイルパス
            Dim newFilePath As String  ' 新ファイルパス
            Dim fileExtension As String  ' ファイル拡張子
            Dim lastDot As Integer  ' 最後のドットの位置
            Dim lastBackslash As Integer  ' 最後のバックスラッシュの位置

            oldFilePath = ws.Cells(i, 1).Value  ' A列から旧ファイルパスを取得
            lastBackslash = InStrRev(oldFilePath, "\")  ' 最後のバックスラッシュの位置を取得
            folderPath = Left(oldFilePath, lastBackslash - 1)  ' フォルダパスを抽出
            lastDot = InStrRev(oldFilePath, ".")  ' 最後のドットの位置を取得
            fileExtension = Mid(oldFilePath, lastDot)  ' ファイル拡張子を取得

            ' セルのフォーマットをテキストに設定し、日付形式で値を設定
            ws.Cells(i, 3).NumberFormat = "@"
            ws.Cells(i, 3).Value = Format(ws.Cells(i, 3).Value, "yyyy-mm-dd")
            
            ' 新しいファイルパスを生成
            newFilePath = folderPath & "\" & ws.Cells(i, 3).Value & "_" & ws.Cells(i, 4).Value & "_" & ws.Cells(i, 5).Value & fileExtension
                
            ' ファイル名変更処理
            If Len(newFilePath) <= 255 Then  ' ファイル名が256文字を超えないようにチェック
                On Error Resume Next  ' エラー発生時の処理を次の行に移動
                Name oldFilePath As newFilePath  ' ファイル名を変更
                If Err.Number <> 0 Then  ' エラーが発生した場合
                    MsgBox "エラー発生: " & Err.Description & " (行: " & i & ")"  ' エラーメッセージを表示
                End If
                On Error GoTo 0  ' エラーハンドリングを元に戻す
            End If
        End If
    Next i
    
    MsgBox "ファイル名を変更しました！"
End Sub
'
'