Excel VBA のモジュールを一括保存する VBA コード

ADINとして忍ばせておくと意外と重宝する。

ExportModule.bas

'［セキュリティセンター／マクロの設定］の
'［VBA プロジェクト オブジェクト モデルへのアクセスを信頼する］に
' チェックを入れておく。

Option Explicit

'// アクティブブック（アクティブブックがない場合はこの Module が書かれているブック（ADINなど））
'// の全モジュールをエクスポート

Sub SaveModule()

    Dim parentFolder    As String   '// 親フォルダのパス
    Dim bookName        As String   '// ブック名
    Dim bookBaseName    As String   '// 拡張子を除いたブック名
    Dim saveFolder      As String   '// 保存フォルダ
    Dim xlMod           As Object   '// モジュールオブジェクト

    parentFolder = "C:\VBA\Excel"

    '// アクティブブックがない場合
    If ActiveWorkbook Is Nothing Then
        bookName = ThisWorkbook.Name
    Else
        bookName = ActiveWorkbook.Name
    End If

    With CreateObject("Scripting.FileSystemObject")
        bookBaseName = .GetBaseName(bookName)
        '// ブック名＋日付を保存フォルダ名にする。
        saveFolder = MakeFolder(.BuildPath(parentFolder, bookBaseName & "_" & Format(Date, "yyyymmdd")))
        For Each xlMod In Workbooks(bookName).VBProject.VBComponents
            xlMod.Export .BuildPath(saveFolder, xlMod.Name & GetModuleExt(xlMod.Type))
        Next xlMod
    End With

    '// 保存フォルダを開く
    Shell "explorer.exe " & saveFolder, vbNormalFocus

End Sub

'// モジュールタイプに対応する拡張子を返す

Private Function GetModuleExt(ByVal module_type As Integer) As String

    Select Case module_type
        Case 1
            GetModuleExt = ".bas"
        Case 2, 100
            GetModuleExt = ".cls"
        Case 3
            GetModuleExt = ".frm"
    End Select

End Function

'// 作成したフォルダのパスを返す

Private Function MakeFolder(ByVal folder_path As String) As String

    CreateObject("WScript.shell").Run "cmd /c md " & chr(34) & folder_path & chr(34), 0, True
    MakeFolder = folder_path

End Function

［更新履歴］

• ［2022/01/07］SaveModuleプロシージャのエラートラップ修正