【Excelマクロ】拡張子別でフォルダに振り分け保存

ファイルを保存するとき、拡張子（.xlsx や .pdf など）によって自動的に保存先フォルダを振り分けられたら便利だと思ったことはありませんか？

業務で作成されるファイルの種類はさまざまですが、すべて同じフォルダに保存してしまうと、後から探すのが大変になります。拡張子ごとに整理されたフォルダへ自動で振り分けられれば、管理の手間がぐっと減ります。

今回は、保存時にファイルの種類（拡張子）に応じて、保存先のフォルダを自動で変えるマクロをご紹介します。

拡張子ごとに保存フォルダを変えるマクロ

次のコードは、保存しようとしているファイルの拡張子を確認し、その種類に応じたフォルダへ保存する処理を行います。保存先は、事前に同じ階層に「xlsx」「xlsm」「pdf」といったフォルダが用意されていることを想定しています。

Sub SaveByExtension()

    Dim fPath As String
    Dim fName As String
    Dim fExt As String
    Dim saveDir As String

    ' 元のファイル名と拡張子を取得
    fPath = ThisWorkbook.FullName
    fName = ThisWorkbook.Name
    fExt = LCase(Right(fName, Len(fName) - InStrRev(fName, ".")))

    ' 拡張子に応じて保存フォルダを決定
    Select Case fExt
        Case "xlsx"
            saveDir = ThisWorkbook.Path & "¥xlsx¥"
        Case "xlsm"
            saveDir = ThisWorkbook.Path & "¥xlsm¥"
        Case "pdf"
            saveDir = ThisWorkbook.Path & "¥pdf¥"
        Case Else
            MsgBox "未対応の拡張子です：" & fExt
            Exit Sub
    End Select

    ' 保存フォルダが存在しなければ作成
    If Dir(saveDir, vbDirectory) = "" Then MkDir saveDir

    ' 保存処理（現在の拡張子を維持）
    ThisWorkbook.SaveCopyAs saveDir & fName

    MsgBox "保存完了：" & vbCrLf & saveDir & fName

End Sub

このマクロを実行すると、たとえば .xlsm ファイルであれば、自動的に「xlsm」フォルダにコピーされて保存されます。元のファイルはそのままで、コピー先に保存する仕様です。

実装するメリット

この方法を取り入れると、次のような利点があります。

• 拡張子ごとの整理が自動化され、探す手間が減る
• 保存ミスや上書き事故を別フォルダに分けることで防止できる
• ファイル形式に応じて業務フローを明確化できる

特に、Excelブック（.xlsx）とマクロ付きブック（.xlsm）を同時に扱う現場では、見た目では違いがわかりづらいため、自動で仕分けておけると安心です。

まとめ

拡張子に応じて保存先を分ける仕組みは、日々の業務ファイルを効率よく管理するうえで非常に役立ちます。

• 拡張子を取得するには InStrRev と Right 関数を組み合わせる
• Select Case でフォルダ振り分けを簡潔に管理
• フォルダが存在しない場合は MkDir で自動作成

このような仕組みを取り入れることで、ファイルの混在によるミスを減らし、業務の効率化につなげていきましょう。ご自身の業務に合わせて、拡張子の種類やフォルダ名を調整して活用してください。