ちょっとずつファイル名を変更するのがかなり面倒
最近同じようなファイルを複数コピーして少しずつ内容を変えて、別の名前で保存するという仕事がありました。
5個～10個くらいのファイルならまだいいのですが、100個単位で必要だったりするとかなりつらいです。
また、一回ある規則で変更したのにまた別の規則で再度変更になったりすると絶望すると思います。
今回はそんなときに便利なファイル名を一括で変更するExcelVBAを紹介します。
ファイル名一覧を取得→変更後のファイルをシートに書き出す
今回私が考えたツールではまずあるフォルダに変更したファイルをすべて格納し、そのファイル名を取得するのが最初のステップ、
続いて変更後のファイル名を記載して実行させることで、一括でファイル名を変更する仕様となっています。
スポンサーリンク
今回使用するワークシート
今回使用するワークシートは下記の書式となっています。
変更したいファイルをひとまとめにしたフォルダを指定することで、A列にファイル名の一覧を表示させます。
C列にも同じ値を入力していますが、こちらを変更してからファイル名変更のVBAを実行することを想定しています。
簡単に実行できるようにするため、私はボタンを配置してマクロを割り当てています。
作成したExcelVBAコード
ファイル名の一覧を取得するコードは下記の通りです。
その後の一括変換をする際の対象を確定させるため、フォルダのパスはワークシートに記載します。
Dim FolderName As String ’文字列を入れる変数として「FolderName」を使う
Dim Index As Integer ’数字を入れる変数として「index」を使う
Dim FileName As String ’文字列を入れる変数として「FileName」を使う
FolderName = Application.GetOpenFilename ’ダイアログを用いて選択したファイルのパスをFolderNameとする①
Dim i
If FolderName = “False” Then ’FolderNameが選択されていなければ作業を終了する
Exit Sub
Else
Cells(1, 5) = FolderName ’対象とするフォルダのパスをセルの値に格納する
End If
’今のフォルダ名には選択したファイル名含まれているので、ファイル名の部分を切り取る作業。
Index = InStrRev(FolderName, “”) ’フォルダ名部分の文字数をカウントする
FolderName = Left(FolderName, Index) ’ カウントした文字数までの部分を切り取ってフォルダ名とする
FileName = Dir(FolderName & “*.*”) ’ フォルダの中に含まれるファイルを取り出す
i = 2
Do While FileName <> “” ’ ファイルがなくなるまで繰り返す
ThisWorkbook.ActiveSheet.Cells(i, 1) = FileName ’A列にファイル名を記述
ThisWorkbook.ActiveSheet.Cells(i, 3) = FileName ’C列にも一旦元ファイル名を記述
i = i + 1
FileName = Dir() ’次のファイルに
Loop
End Sub
C列はA列と同じ値になっていますので、何かしら変更を加えてからファイル名を変更するVBAを実行します。
続いて実行するファイル名を変更するVBAコードは下記の通りです。
ファイル名を変更するにはFSO（FileSystemObject）を用いると便利です。
「FSO.GetFile(対象ファイルのフルパス).Name=”変更したいファイル名”」の書式で記載します。
ファイルが存在しなかったり、もともと存在する名前に変更しようとするとエラーになります。
Dim FSO As Object
Set FSO = CreateObject(“Scripting.FileSystemObject”)
Dim FolderName As String ’文字列を入れる変数として「FolderName」を使う
Dim Index As Integer ’数字を入れる変数として「index」を使う
Dim FileName As String ’文字列を入れる変数として「FileName」を使う
Dim i
’対象のフォルダパスが指定されていればダイアログは出さない
If Cells(1, 5) = “” Then
FolderName = Application.GetOpenFilename ’ダイアログを用いて選択したファイルのパスをFolderNameとする①
If FolderName = “False” Then ’FolderNameが選択されていなければ作業を終了する
Exit Sub
End If
Else
FolderName = Cells(1, 5).Text
End If
’今のフォルダ名には選択したファイル名含まれているので、ファイル名の部分を切り取る作業。
Index = InStrRev(FolderName, “”) ’フォルダ名部分の文字数をカウントする
i = 2
FolderName = Left(FolderName, Index) ’ カウントした文字数までの部分を切り取ってフォルダ名とする
Do While Cells(i, 1) <> “” ’ ファイルがなくなるまで繰り返す
FileName = Cells(i, 1)
FSO.GetFile(FolderName & FileName).Name = Cells(i, 3).Text
i = i + 1
Loop
Set FSO = Nothing
End Sub
フリーのソフトなどでも同じような処理はできると思いますが、セキュリティでフリーソフトの使用が禁じられている職場のPCの場合には上記のVBAコードは簡単に作成できて用途も多いと思います。
またExcelの関数Substitute、Left、Midなどを使えることもフリーソフト単独では得られない便利さだと思います。
コメント