VBA 导出VBA工程模块文件

1. Layout

2.Code

Option Explicit

Type TYPE_FILE
    Fullpath As String
    Extension As String
    ModuleType As String
End Type

Const FD_STD_MDL As String = "001.StdModule"
Const FD_CLS_MDL As String = "002.ClassModule"
Const FD_FRM_MDL As String = "003.MSForm"
Const FD_DOC_MDL As String = "100.Document"

Sub ExportModule()
    '-------------------------------------
    ' Declare
    '-------------------------------------
    Dim wbExport As Workbook
    Dim wbImport As Workbook
    Dim mdlModule As VBComponent
    Dim strExportWorkbookName As String
    Dim strExportPath As String
    Dim strImportWorkbookName As String
    Dim i As Long
    Dim arrFile() As TYPE_FILE
    Dim strFile As String
    Dim blnChkFlg As Boolean

On Error GoTo ErrProcess

    '-------------------------------------
    ' Init
    '-------------------------------------
    strExportWorkbookName = Range("B1").Value
    strExportPath = Range("B3").Value
    strImportWorkbookName = Range("B4").Value
    ReDim Preserve arrFile(0)
    blnChkFlg = False
    
    '-------------------------------------
    ' Check
    '-------------------------------------
    'Export Workbook
    If strExportWorkbookName = vbNullString Then
        MsgBox "Export Workbook is required."
        Exit Sub
    End If
    'Export Path
    If strExportPath = vbNullString Then
        MsgBox "Export Path is required."
        Exit Sub
    End If
    strExportPath = strExportPath & "\"
    strExportPath = Replace(strExportPath, "\\", "\")
    'Export Module Type
    If ActiveSheet.chkStdModule.Value Then
        blnChkFlg = True
    End If
    If ActiveSheet.chkClassModule.Value Then
        blnChkFlg = True
    End If
    If ActiveSheet.chkMSForm.Value Then
        blnChkFlg = True
    End If
    If blnChkFlg = False Then
        MsgBox "Export Module Type choose at least one."
        Exit Sub
    End If
       
    '-------------------------------------
    ' Setting
    '-------------------------------------
    'Export workbook
    Set wbExport = Workbooks(strExportWorkbookName)
    'Import workbook
    If strImportWorkbookName <> vbNullString Then
        Set wbImport = Workbooks(strImportWorkbookName)
    End If
    'Set fullpath and extension
    If ActiveSheet.chkStdModule.Value = True Then
        ReDim Preserve arrFile(UBound(arrFile) + 1)
        arrFile(UBound(arrFile)).Fullpath = strExportPath & FD_STD_MDL & "\"
        arrFile(UBound(arrFile)).Extension = ".bas"
        arrFile(UBound(arrFile)).ModuleType = vbext_ct_StdModule
    End If
    If ActiveSheet.chkClassModule.Value = True Then
        ReDim Preserve arrFile(UBound(arrFile) + 1)
        arrFile(UBound(arrFile)).Fullpath = strExportPath & FD_CLS_MDL & "\"
        arrFile(UBound(arrFile)).Extension = ".cls"
        arrFile(UBound(arrFile)).ModuleType = vbext_ct_ClassModule
    End If
    If ActiveSheet.chkMSForm.Value = True Then
        ReDim Preserve arrFile(UBound(arrFile) + 1)
        arrFile(UBound(arrFile)).Fullpath = strExportPath & FD_FRM_MDL & "\"
        arrFile(UBound(arrFile)).Extension = ".frm"
        arrFile(UBound(arrFile)).ModuleType = vbext_ct_MSForm
    End If
    
    '-------------------------------------
    ' Create export folder
    '-------------------------------------
    For i = 1 To UBound(arrFile)
        CreateFolderIfNotExists (arrFile(i).Fullpath)
    Next i
    
    '-------------------------------------
    ' Main process
    '-------------------------------------
    For Each mdlModule In wbExport.VBProject.VBComponents
        If mdlModule.Name <> "ExportModule" Then
            'Export module
            strFile = vbNullString
            For i = 1 To UBound(arrFile)
                If mdlModule.Type = arrFile(i).ModuleType Then
                    strFile = arrFile(i).Fullpath & mdlModule.Name & arrFile(i).Extension
                    mdlModule.Export (strFile)
                    Exit For
                End If
            Next i
            'Import module
            If Not wbImport Is Nothing And strFile <> vbNullString Then
                On Error Resume Next
                wbImport.VBProject.VBComponents.Import (strFile)
                On Error GoTo 0
            End If
        End If
    Next mdlModule
    
    Set wbExport = Nothing
    Set wbImport = Nothing

    MsgBox "Done."
    Exit Sub
ErrProcess:
    MsgBox Err.Description

End Sub

Sub CreateFolderIfNotExists(folderPath As String)
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    If Len(Dir(folderPath, vbDirectory)) = 0 Then
        fso.CreateFolder folderPath
    End If
    
    Set fso = Nothing
End Sub