こちらの続きです。
プロジェクト内のモジュール類を全てエクスポート1 - C#ATIA
プロジェクト毎にエクスポートする事すら面倒な方(僕)用に、
VBAエディタに含まれている全てのプロジェクトの全ての
モジュールをエクスポートするように変更しました。
'vba 全てのプロジェクト内のモジュールをエクスポート '上書きチェックしてないので、上書きます '事前に"Microsoft APC 7.1 Object Library"等の '参照設定しておく必要あります '参考にさせてもらいました 'https://vbabeginner.net/bulk-export-of-standard-modules/ '"Microsoft Visual Basic for Application Extensibilly 5.3"の参照設定は '不要です Option Explicit 'エクスポートするベースのフォルダ 'パスの有無は無チェックです Private Const EXPORT_BASE_DIR = "C:\temp" Sub CATMain() 'VBE取得 Dim vbe As Object Set vbe = get_vbe() If vbe Is Nothing Then Exit Sub 'プロジェクトコレクション Dim vbProjs As Object Set vbProjs = vbe.VBProjects '確認 Dim msg As String msg = vbProjs.count & "個のプロジェクトの全てのモジュールを" & _ "[" & EXPORT_BASE_DIR & "]にエクスポートします。" & vbCrLf & _ "宜しいですか?" If MsgBox(msg, vbOKCancel + vbQuestion) = vbCancel Then Exit Sub End If 'エクスポート Dim vbProj As Object For Each vbProj In vbProjs export_project vbe, vbProj.name Next MsgBox "Done" End Sub 'プロジェクト内の全てのモジュールのエクスポート 'プロジェクト名のフォルダも作製 Private Sub export_project( _ ByVal vbe As Object, _ ByVal projName As String) 'プロジェクト取得 Dim vbProj As Object Set vbProj = vbe.VBProjects.Item(projName) 'コンポーネント取得 Dim vbComps As Object Set vbComps = vbProj.VBComponents If vbComps.count < 1 Then Exit Sub 'エクスポートフォルダパス Dim expDir As String expDir = get_folder_path(EXPORT_BASE_DIR, projName) 'エクスポート Dim module As Object Dim extension As String Dim path As String For Each module In vbComps extension = get_extension(module) If Len(extension) < 1 Then GoTo CONTINUE path = expDir & "\" & module.name & "." & extension module.Export path Debug.Print "export : " & path CONTINUE: Next End Sub 'エクスポート用の拡張子取得 Private Function get_extension( _ ByVal module As Object) _ As String Dim extension As String Select Case module.Type Case vbext_ct_ClassModule extension = "cls" Case vbext_ct_MSForm extension = "frm" Case vbext_ct_StdModule extension = "bas" Case Else extension = "" End Select get_extension = extension End Function 'vbaエディタ取得 'Special_Thx Mr.imihito Private Function get_vbe() _ As Object Set get_vbe = Nothing 'VBAのバージョンチェック Dim COMObjectName$ #If VBA7 Then COMObjectName = "MSAPC.Apc.7.1" #ElseIf VBA6 Then COMObjectName = "MSAPC.Apc.6.2" #Else MsgBox "VBAのバージョンが未対応です" Exit Function #End If 'APC取得 Dim oApc As Object: Set oApc = Nothing On Error Resume Next Set oApc = CreateObject(COMObjectName) On Error GoTo 0 'VBE取得 If oApc Is Nothing Then MsgBox "MSAPC.Apcが取得できませんでした" Exit Function End If Set get_vbe = oApc.vbe End Function 'フォルダパスの取得 - なきゃ作る Private Function get_folder_path( _ ByVal dirPath As String, _ ByVal name As String) _ As String Dim fso As Object Set fso = CreateObject("Scripting.FileSystemObject") Dim path As String path = dirPath & "\" & name If Not fso.FolderExists(path) Then fso.CreateFolder path End If get_folder_path = path End Function
定数で指定したフォルダ内に、プロジェクトの名前のフォルダを作成し、
その中に全てのモジュールをエクスポートします。
こんな感じです。