EXCELマクロでファイル名を一括変換する

2022年4月19日

EXCELマクロを使うと既存ファイルの名前を一括で変更することができます。
ファイル名の付け方のルールが変わった場合、手作業で変更するには大変な労力がかかります。
こんな時、このサンプルアプリを利用すると簡単に解決できます。
ケースバイケースでコードを修正して活用ください。

関数の説明

下に記載したコードでコンピューターのファイル システムへアクセスするための方法を解説します。
今回は fso というオブジェクトにFileSystemObjectを代入しました。
fsoオブジェクトにCreateTextFileメソッドを使うことで、DドライブにTEST.txt ファイルを作成し、作成したファイルに対し文字入力をしています。
WriteLineが文字の記入で、CloseがTextStreamを閉じる処理です。
プログラムからファイルを開いた場合は閉じる処理が必要になります。

 Sub ファイル作成文字書込み()

 'コンピューターのファイル システムへアクセスするための準備
  Dim fso As Object
 ' fsoというオブジェクトにFileSystemObjectを代入
  Set fso = CreateObject("Scripting.FileSystemObject")

 'fsoオブジェクトにCreateTextFileメソッドを使うことで、C:Samurai に samurai.txt を作成し、TextStream オブジェクトとして ts に代入
  With fso.CreateTextFile("D:\TEST.txt", True)

   'WriteLineで文字( TEST.txt ファイルに書き込みます ) を記入
    .WriteLine ("TEST.txt ファイルに書き込みます")

   'TextStreamを閉じる処理
    .Close

  End With

 'fso変数をリセット
  Set fso = Nothing

End Sub

サンプルコードの処理内容

「ファイル名変更」ボタンをクリックすると、当マクロが書かれたExcelファイルと同じフォルダにおかれているファイル名をテーブル表に基づいて変換してくれます。

サンプルコード    コードの作成手順はこちら

「ThisWorkbook.Path」でエラーが発生した場合、
下記リンク先に回避する方法を記載しましたので参照ください。
https://scodebank.com/?p=696

Sub ファイル名変更()

 'コンピューターのファイル システムへアクセスするための準備
  Dim fso As Object
  Set fso = CreateObject("Scripting.FileSystemObject") ' インスタンス化

 '読込み先ファイル名を取得
  Dim myDir As String      '当ファイルがあるフォルダパスを入れる変数を定義
  Dim ReadFile As String   '各読込み先ファイル
 
  myDir = ThisWorkbook.Path     '当ファイルがあるフォルダのパスをセット

  Dim fl As Object              '当ファイルがあるフォルダ名を入れるための変数を定義
  Set fl = fso.GetFolder(myDir) '当ファイルがあるフォルダ名をセット
 
  Dim fileName As String   '特定の既存ファイル名を入れるための変数を定義
  Dim f As Variant         '個々の既存ファイル名を入れるための変数を定義(For Each 文で使用)
  
 '検索結果を入れるRange変数を定義
  Dim Rng As Range
 '検索してヒットした行番号を入れる変数を定義
  Dim HitRow As Long
  
 'ワークシートを指定する
  Dim Sh1 As Worksheet
  Set Sh1 = ThisWorkbook.Worksheets("Sheet1")

        
  'fl.Filesプロパティから、そのフォルダの File オブジェクトの一覧を取得
  For Each f In fl.Files ' フォルダ内のファイルを取得

   '検索キーをセット
    fileName = f.Name             ' f.Nameプロパティから、そのファイルの拡張子付きの名前を取得

   '既存のファイル名がエクセル上の対比表にあるか検索する
    Set Rng = Sh1.Range("B:B").Find(What:=fileName, LookAt:=xlWhole)

   '検索でヒットした場合は新しいファイル名に変換する。ヒットしなかった場合は無視する。
    If Not (Rng Is Nothing) Then

      'ヒットした行番号をセット
       HitRow = Rng.Row
      '既存のファイル名をエクセルの対比表に示されているファイル名に変更する
       f.Name = Sh1.Cells(HitRow, 4).Value

    End If
    
  Next
  

 'fso変数をリセット
  Set fso = Nothing
    
 '処理完了メッセージを表示
  MsgBox "ファイル名変換を完了しました。"

End Sub