【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を使った方が簡単だし直感的だった。
参考記事
この記事が気に入ったらサポートをしてみませんか?