vba - 从 Excel 电子表格中提取 VBA

Question

有没有一种干净的方法可以从电子表格中提取 VBA 并将其存储在存储库中。

电子表格几乎不会改变，但 VBA 会改变。将整个电子表格存储在存储库中使得很难在不同的 VBA 修订版之间进行比较，以了解哪些代码已更改以及谁更改了它。

我们使用 VBA 6.5/Excel 2003。

Answer 1

以前版本的 Excel 和 Access(2003 年之前)通过加载项支持 VBA 源代码版本控制。我在 Office 2000 中非常有效地使用了这一点。

Visual SourceSafe (VSS) 对 VBA 的支持是 dropped with the release of Office 2003 ，但 Office XP Developer 附带的加载项显然是 works with Office 2003 .

微软知识库文章:

• Using Visual SourceSafe with Documents and VBA Code

• Using the Visual SourceSafe Add-In with the Visual Basic Environment

如果失败，您可以使用此代码提取 VBA 代码(来自 here 但缺少最终的对象清理)。阅读网页以了解注意事项:

option explicit

Const vbext_ct_ClassModule = 2
Const vbext_ct_Document = 100
Const vbext_ct_MSForm = 3
Const vbext_ct_StdModule = 1

Main

Sub Main
    Dim xl
    Dim fs
    Dim WBook
    Dim VBComp
    Dim Sfx
    Dim ExportFolder

    If Wscript.Arguments.Count <> 1 Then
        MsgBox "As the only argument, give the FULL path to an XLS file to extract all the VBA from it."
    Else

        Set xl = CreateObject("Excel.Application")
        Set fs = CreateObject("Scripting.FileSystemObject")

        xl.Visible = true

        Set WBook = xl.Workbooks.Open(Trim(wScript.Arguments(0)))

        ExportFolder = WBook.Path & "\" & fs.GetBaseName(WBook.Name)

        fs.CreateFolder(ExportFolder)

        For Each VBComp In WBook.VBProject.VBComponents
            Select Case VBComp.Type
                Case vbext_ct_ClassModule, vbext_ct_Document
                    Sfx = ".cls"
                Case vbext_ct_MSForm
                    Sfx = ".frm"
                Case vbext_ct_StdModule
                    Sfx = ".bas"
                Case Else
                    Sfx = ""
            End Select
            If Sfx <> "" Then
                On Error Resume Next
                Err.Clear
                VBComp.Export ExportFolder & "\" & VBComp.Name & Sfx
                If Err.Number <> 0 Then
                    MsgBox "Failed to export " & ExportFolder & "\" & VBComp.Name & Sfx
                End If
                On Error Goto 0
            End If
        Next

        xl.Quit

        Set fs = Nothing
        Set xl = Nothing

    End If
End Sub