C#ATIA

↑タイトル詐欺 主にFusion360API 偶にCATIA V5 VBA(絶賛ネタ切れ中)

プロジェクト内のモジュール類を全てエクスポート2

こちらの続きです。
プロジェクト内のモジュール類を全てエクスポート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

定数で指定したフォルダ内に、プロジェクトの名前のフォルダを作成し、
その中に全てのモジュールをエクスポートします。
こんな感じです。