VBA-抽出模塊，類型，對象（用於代碼統計和模塊開發）

Public Sub exportModel()
    Dim exportPath As String
    exportPath = ThisWorkbook.path & "\source"
    If Dir(exportPath, vbDirectory) = Empty Then
        MkDir exportPath
    End If
    
    Dim extendName As String
    Dim vbc As VBComponent
    
    With ThisWorkbook.VBProject
        For Each vbc In .VBComponents
            Dim lines As Integer
            lines = .VBComponents(vbc.name).CodeModule.CountOfLines
            If lines > 0 Then
                Select Case vbc.Type
                Case vbext_ct_ClassModule    'class module
                    extendName = ".cls"
                Case vbext_ct_Document    'excel object
                    extendName = ".sht"
                    extendName = ""  'ignore document
                Case vbext_ct_MSForm    'form
                    extendName = ".frm"
                Case vbext_ct_StdModule    'module
                    extendName = ".bas"
                End Select
                If extendName <> "" And vbc.name <> "Export_Import_Model" Then
                    vbc.Export exportPath & "\" & vbc.name & extendName
                    .VBComponents.Remove vbc
                End If
            End If
        Next
    End With
    
    MsgBox "Export Done!"
End Sub

Public Sub exportAndImportModel()
    Call exportModel
    Call importModel
End Sub

Public Sub importModel()
    removeModel
    addModel
    MsgBox "Import Done!"
End Sub

Private Sub removeModel()
    Dim exportPath As String
    exportPath = ThisWorkbook.path & "\source"
    
    Set fso = CreateObject("scripting.filesystemobject")
    Set ff = fso.getfolder(exportPath)
    For Each file In ff.Files
        Dim cName As String
        cName = Left(file.name, Len(file.name) - 4)
        If cName <> "Export_Import_Model" Then
            If modelExists(cName) Then
                ThisWorkbook.VBProject.VBComponents.Remove ThisWorkbook.VBProject.VBComponents(cName)
            End If
        End If
    Next
    Set ff = Nothing
    Set fso = Nothing
End Sub

Private Function modelExists(cName As String)
    On Error GoTo ErrHandle
    Dim name As String
    name = ThisWorkbook.VBProject.VBComponents(cName).CodeModule.name
    modelExists = True
    Exit Function
ErrHandle:
    modelExists = False
End Function


Private Sub addModel()
    Dim exportPath As String
    exportPath = ThisWorkbook.path & "\source"
    
    Set fso = CreateObject("scripting.filesystemobject")
    Set ff = fso.getfolder(exportPath)
    For Each file In ff.Files
        cName = Left(file.name, Len(file.name) - 4)
        If cName <> "Export_Import_Model" Then
            ThisWorkbook.VBProject.VBComponents.Import fileName:=file.path
        End If
    Next
    Set ff = Nothing
    Set fso = Nothing
End Sub