【VBA】特定のフォルダにある全てのExcelファイルのモジュールを一括エクスポートするコード

前置き

大昔に作ったものなのでおかしいところがあるかも(動くことは確認済み)

説明

特定のフォルダに保存されているExcelファイルのモジュールを全てエクスポートしmodule-YYMMDD(今日の日付)フォルダに保存する。

事前準備

マクロのセキュリティ設定

開発タブ→コード→マクロのセキュリティ、もしくはファイルタブ→オプション→トラストセンター→トラストセンターの設定から「VBAプロジェクトオブジェクトモデルへのアクセスを信頼する(V)」を有効にする。(モジュールのエクスポートを可能にするため)

VBComponentの参照設定

VBEのツールタブ→参照設定から「Microsoft Visual Basic for Application Extensibilly 5.3」を有効にする。(VBComponentsクラスを利用するため)

コード

Option Explicit

Sub ExportMacros()

    Application.ScreenUpdating = False

    Dim folderPath As String        '// 親フォルダのパス
    Dim saveFolderPath As String    '// 保存先フォルダのパス
    Dim bookName As String          '// ブック名
    Dim fileExtension As String     '// 拡張子
    Dim wb As Workbook              '// ブック
    Dim vbComp As VBComponent       '// モジュール
    
    '// フォルダを指定
    folderPath = "エクスポートしたいファイルが保存されているフォルダのパスを指定"
    saveFolderPath = folderPath & MakeDateFolder("module")
    
    '// 保存先フォルダが無い場合は作成
    If Dir(saveFolderPath, vbDirectory) = "" Then
    
        MkDir saveFolderPath
        
    End If
    
    '// ブック名取得
    bookName = Dir(folderPath & "*.xls*")
    
    Do While bookName <> ""
    
        Set wb = Workbooks.Open(folderPath & bookName)
        
        '// モジュールをループ
        For Each vbComp In wb.VBProject.VBComponents

            Select Case vbComp.Type
            
                Case vbext_ct_StdModule     '// 標準モジュール
                    fileExtension = ".bas"
                    
                Case vbext_ct_MSForm        '// フォーム
                    fileExtension = ".frm"
                    
                Case vbext_ct_ClassModule   '// クラス
                    fileExtension = ".cls"
                    
                Case Else                   '// その他
                    fileExtension = ""
                    
            End Select
            
            If fileExtension <> "" Then
            
                '// エクスポート
                vbComp.Export saveFolderPath & "\" & vbComp.name & fileExtension
                
            End If
            
        Next vbComp
        
        '// ファイルを保存せずに閉じる
        wb.Close SaveChanges:=False
        
        '次のファイルへ
        bookName = Dir
        
    Loop
    
    Application.ScreenUpdating = True
    
    '// 保存先フォルダを開く
    Shell "explorer.exe " & saveFolderPath, vbNormalFocus

End Sub
'//フォルダのパスをname-YYMMDD形式で取得
Function MakeDateFolder(ByVal name As String) As String

    MakeDateFolder = name & "-" & Format(Date, "yymmdd")
    
End Function

反省点

  • 昔稼働させていた時に思ったがそもそもそんなに色々なファイルでマクロを作らない。

  • エラー処理が甘い。このコードだとアクセス権限が無いフォルダにアクセスする時やマクロを実行するファイルとエクスポートしたいファイルの名前が同じ時にエラーが起きてしまう。

  • このコードを運用するよりXVBAを使った方が簡単だし直感的だった。

参考記事


この記事が気に入ったらサポートをしてみませんか?