excel - 如何将 .cls 文件中的代码导入没有标题信息的工作表代码模块？

Question

我有一个类模块，可以动态更新分布式工作簿中的所有代码模块。下面的片段显示了我如何更新“ThisWorkbook”模块。这基本上是删除工作簿模块中的现有代码，然后从 .CLS 文件中导入新代码。
问题是，CodeModule.AddFromFile方法也从文件中复制标题信息。
我正在使用 CodeModule.DeleteLines清理这个。我宁愿一开始就不要把这个垃圾带进来。
添加代码时是否有任何方法可以忽略此 header 信息，或者是否有其他方法可以在不复制 header 信息的情况下导入代码？

Private Sub ImportNew()
    Dim vbP As VBIDE.VBProject
    Dim vbC As VBIDE.VBComponent
    Set vbP = Application.ThisWorkbook.VBProject
    
    Dim FSO As scripting.FileSystemObject
    Dim fsoFolder As scripting.Folder
    Dim fsoFile As scripting.File
    Set FSO = New scripting.FileSystemObject
    Set fsoFolder = FSO.GetFolder(pRep)
    
    For Each fsoFile In fsoFolder.Files
        Dim FileName As String
        Dim CodeName As String
        Dim FileDate As Date
    
        FileName = fsoFile.ShortName
        CodeName = Left(FileName, InStrRev(FileName, ".") - 1)
        FileDate = fsoFile.DateLastModified

        Select Case CodeName
            Case "ThisWorkbook"
                'Do some stuff to check version - update if needed:
                Dim Dest As VBIDE.CodeModule
                Set Dest = vbP.VBComponents("ThisWorkbook").CodeModule
                Dest.DeleteLines 1, Dest.CountOfLines 'Erase existing lines
                Dest.AddFromFile fsoFile.Path 'import new code from file
                'remove header info from file:
                Dim OpExLine As Long
                If Dest.Find("Option Explicit", OpExLine, 0, Dest.CountOfDeclarationLines, 999) Then
                    Dest.DeleteLines 1, OpExLine - 1
                End If
                    
            Case "Coder"
                'do nothing
            Case Else
                'Do some other stuff
        End Select
        'Do some other stuff
    Next
End Sub

Answer 1

您可以像这样导入模块文件:

ThisWorkbook.VBProject.VBComponents.Import fsoFile.Path

附录
OP 指出无法导入工作表模块。出于这个原因，我们需要删除类头。工作表模块标题的最后一行始终相同。知道这一点，只需按标题拆分代码，删除第一个元素并重新加入文本即可。

Function RemoveClassHeader(Text As String) As String
    Const LastClassAttribute As String = "Attribute VB_Exposed = True"
    Dim Parts() As String
    Parts = Split(Text, LastClassAttribute)
    If UBound(Parts) > 0 Then Parts(0) = ""
    RemoveClassHeader= Join(Parts, "")
End Function