ファイル名変更するマクロ

'********************************************************
'* マクロ名: ファイル一覧
'* 概要    : 指定したフォルダ内のファイル名一覧を、指定のセル範囲に出力する
'*
'* 前提:
'*   - 「Microsoft Scripting Runtime」の参照設定が必要（AllFileName関数内でFileSystemObject使用）
'*   - シート上に「フォルダ名」という名前付きセル範囲が存在すること（そこに対象フォルダパスを入力）
'*
'* 処理内容:
'*   - A列の5行目以降をクリア
'*   - 指定フォルダ内のファイル名を取得
'*   - 取得したファイル名をA列5行目以降に順番に出力
'********************************************************
Sub ファイル一覧()

    ' 出力範囲クリア（A列5行目以降のデータを削除）
    ' 最終行を取得し、5行目～最終行のA列をクリア
    Range(Cells(5, 1), Cells(Cells(Rows.Count, 1).End(xlUp).Row, 1)).ClearContents

    ' ファイル名を格納する配列を宣言
    Dim Files() As String

    ' 指定フォルダ内のファイル名を取得
    ' 「フォルダ名」という名前のセル範囲からフォルダパスを取得し、AllFileName関数に渡す
    ' AllFileName関数の戻り値は、ファイル名の配列
    ' 参照url：https://blogvba.com/allfilename/
    Files = AllFileName(Range("フォルダ名").Value)

    ' ファイル名をセルに書き出す
    Dim i As Long
    ' 配列の1番目から順に処理（A列5行目から出力）
    For i = 1 To UBound(Files)
        Cells(i + 4, 1).Value = Files(i)
    Next i

End Sub

'********************************************************
'* マクロ名: ファイルのリネーム
'* 概要    : 指定の一覧表に基づき、指定フォルダ内のファイル名を一括変更する
'*
'* 処理対象:
'*   - 「フォルダ名」という名前のセル範囲に対象フォルダのパスを入力
'*   - A列に「現在のファイル名」、B列に「新しいファイル名（拡張子なし）」を入力
'*   - A4セルを起点にした表形式で、5行目以降のデータを対象とする
'*
'* 注意点:
'*   - 新しいファイル名には拡張子を含めず、既存ファイルと同じ拡張子でリネーム
'*   - ファイルが存在しない場合やエラー処理は別途実装が必要
'*   - FileRenameSameExtension関数が必要（別途実装）
'********************************************************
Sub ファイルのリネーム()

    ' データ格納用の変数
    Dim Target As Range                 ' 対象範囲オブジェクト
    Dim TargetValue() As Variant        ' 2次元配列でデータを一括取得

    ' 表の見出しを除いたデータ範囲を取得（A4セルを基準にCurrentRegion）
    ' CurrentRegion：連続するデータ範囲全体
    With Range("A4").CurrentRegion
        Set Target = .Resize(.Rows.Count - 1).Offset(1) ' 見出し行を除外
    End With

    ' 対象データを2次元配列に格納（高速処理）
    TargetValue = Target.Value

    ' 配列の1行目から最終行までループ
    Dim i As Long
    For i = LBound(TargetValue) To UBound(TargetValue)

        ' A列（旧ファイル名）、B列（新ファイル名）が両方とも空でない場合のみ処理
        If TargetValue(i, 1) <> "" And TargetValue(i, 2) <> "" Then

            ' フォルダパス取得（名前定義「フォルダ名」から）
            Dim FilePath As String
            FilePath = Range("フォルダ名").Value & "\" & TargetValue(i, 1)

            ' 旧ファイル名、新ファイル名（拡張子なし）を取得
            Dim myFileName As String
            myFileName = TargetValue(i, 1)

            Dim myFileRename As String
            myFileRename = TargetValue(i, 2)

            ' ファイル名変更（FileRenameSameExtension関数を呼び出し）
            ' 引数:
            '   myFileName     ：旧ファイル名
            '   myFileRename   ：新ファイル名（拡張子除く）
            '   Range("フォルダ名")：フォルダのパス
            Call FileRenameSameExtension(myFileName, myFileRename, Range("フォルダ名").Value)
            '* 参照url：https://blogvba.com/filerenamesameextension/

        End If
    Next i

End Sub