あなたはフォルダ内のファイルの拡張子をいっぺんに変えたいと思ったことはありませんか？
例えば、他の人からもらったデータにいろんな拡張子が混在している場合（例：.jpeg, .jpg, .JPG）、それを一括で「.jpg」に統一すると、管理しやすくなり、プログラム処理や検索も安定します。
別の例では、ファイルの中身は同じでも、拡張子だけ変えることで別アプリで開ける場合があります。
「.txt」 →「 .csv」 に変えると、Excelで簡単に開ける
データが多いと、１つずつ手作業はやってられないですよね。
そんなときはエクセルVBAでファイルの拡張子をいっぺんに変えれば簡単です。
今回は「エクセルVBAでフォルダ内のファイルの拡張子をいっぺんに変える方法」を紹介します。
エクセルVBAでフォルダ内のファイルの拡張子をいっぺんに変える方法
エクセルVBAでフォルダ内のファイルの拡張子をいっぺんに変える方法です。
こんなイメージです。
マクロを作るときは、「開発」タブを使います。
開発タブが出ていない方は、下のリンクで出し方を紹介していますので、まずは準備をお願いします。
→エクセルで開発タブを表示する方法
１．「開発」タブをクリック →「挿入」をクリック →「ボタン」をクリック
２．「新規作成」をクリック
３．コード入力画面が開く
４．コードを入力
コードを入力します。
Aフォルダ内のファイルの拡張子を、A2セルの拡張子に変更する、という内容です。
５．ボタンができた
ボタンができた
６．Aフォルダ内にファイルを準備
拡張子を変えたいファイルをAフォルダに入れます。
今回は、エクセルやPNGなども入れました。
７．A2セルに変更後の拡張子を入れる
A2セルに変更後の拡張子を入れます。
ここでは「txt」にしました。
８．ボタンを押す →拡張子が変更できた
ボタンを押すと、Aフォルダ内の拡張子が「txt」に変わりました。
完了の表示が出ます。
フォルダを見ると、ちゃんと拡張子が変更されてました。
これで拡張子の一括変更が簡単ですね！
まとめ
エクセルVBAでフォルダ内のファイルの拡張子をいっぺんに変える方法です。
１．「開発」タブをクリック →「挿入」をクリック →「ボタン」をクリック
２．新規作成をクリック
３．コードを入れる画面が出る
４．コードを入力
５．ボタンができた
６．Aフォルダ内にファイルを準備
７．A2セルに変更後の拡張子を入れる
８．ボタンを押す →拡張子が変更できた
これでフォルダ内のファイルの拡張子変更が一括で出来て簡単です！
注意点
・拡張子を変えても中身（形式）は変わりません。
例：image.jpg を image.png にしても、実際はJPEGのまま。
・Windowsは拡張子でアプリを判断しているので、開けなくなるリスクもあります。
・実際の変換（例：JPEG→PNG）をしたい場合は、拡張子変更ではなく**形式変換（変換ツールやPython等）**が必要です。
最後に今回使ったコードです。
Dim folderPath As String
Dim fso As Object
Dim file As Object
Dim newExt As String
Dim fileName As String
Dim newName As String
Dim userName As String
' ユーザー名を取得してデスクトップパスを作成
userName = Environ("USERNAME")
folderPath = "C:\Users\" & userName & "\Desktop\A\"
' セルA2から新しい拡張子を取得
newExt = Trim(Sheet1.Range("A2").Value)
If newExt = "" Then
MsgBox "セルA2に新しい拡張子を入力してください。", vbExclamation
Exit Sub
End If
' 「.」が付いていなければ追加
If Left(newExt, 1) <> "." Then
newExt = "." & newExt
End If
' フォルダ存在チェック
If Dir(folderPath, vbDirectory) = "" Then
MsgBox "フォルダが見つかりません: " & folderPath, vbCritical
Exit Sub
End If
Set fso = CreateObject("Scripting.FileSystemObject")
' フォルダ内のファイルをループ
For Each file In fso.GetFolder(folderPath).Files
fileName = fso.GetBaseName(file.Name)
newName = folderPath & fileName & newExt
' リネーム実行
On Error Resume Next
Name file.Path As newName
If Err.Number <> 0 Then
MsgBox "変更できませんでした: " & file.Name, vbExclamation
Err.Clear
End If
On Error GoTo 0
Next file
MsgBox "拡張子の変更が完了しました！", vbInformation
コメント