是否可以使用API​​从Word 2007" docm"文档中提取所有VBA代码？

我发现了如何在运行时插入VBA代码，以及如何删除所有VBA代码，但没有将实际代码提取到我可以存储的流或者字符串中(以后再插入其他文档中)。

任何提示或者资源，将不胜感激。

编辑：感谢大家，Aardvark的答案正是我所寻找的。我已经将他的代码转换为C＃，并能够使用Visual Studio 2008从类库中调用它。

using Microsoft.Office.Interop.Word;
using Microsoft.Vbe.Interop;

...

public List<string> GetMacrosFromDoc()
{
    Document doc = GetWordDoc(@"C:\Temp\test.docm");

    List<string> macros = new List<string>();

    VBProject prj;
    CodeModule code;
    string composedFile;

    prj = doc.VBProject;
    foreach (VBComponent comp in prj.VBComponents)
    {
        code = comp.CodeModule;

        // Put the name of the code module at the top
        composedFile = comp.Name + Environment.NewLine;

        // Loop through the (1-indexed) lines
        for (int i = 0; i < code.CountOfLines; i++)
        {
            composedFile += code.get_Lines(i + 1, 1) + Environment.NewLine;
        }

        // Add the macro to the list
        macros.Add(composedFile);
    }

    CloseDoc(doc);

    return macros;
}

解决方案

回答

我们必须添加对Microsoft Visual Basic for Applications Extensibility 5.3(或者我们拥有的任何版本)的引用。我的包装盒上有VBA SDK等，因此这可能不是Office附带的。

另外，我们还必须启用对VBA对象模型的访问，具体请参见Word选项中的"信任中心"。这是Office提供的所有其他其他宏安全设置的补充。

本示例将从其本身是VBA宏的当前文档中提取代码(并显示其自身以及任何其他代码)。还有一个Application.vbe.VBProjects集合可访问其他文档。尽管我从未做过，但我假设外部应用程序也可以使用此VBProjects集合打开文件。安全对于这些东西很有趣，因此可能很棘手。

我还想知道docm文件格式现在是像docx这样的XML吗？那会是更好的方法吗？

Sub GetCode()

    Dim prj As VBProject
    Dim comp As VBComponent
    Dim code As CodeModule
    Dim composedFile As String
    Dim i As Integer

    Set prj = ThisDocument.VBProject
        For Each comp In prj.VBComponents
            Set code = comp.CodeModule

            composedFile = comp.Name & vbNewLine

            For i = 1 To code.CountOfLines
                composedFile = composedFile & code.Lines(i, 1) & vbNewLine
            Next

            MsgBox composedFile
        Next

End Sub

回答

我们可以将代码导出到文件中，然后再读回。

我一直在使用下面的代码来帮助我将某些Excel宏保持在源代码控制下(使用Subversion和TortoiseSVN)。每当我在打开VBA编辑器进行保存时，它基本上会将所有代码导出到文本文件中。我将文本文件放在Subversion中，以便进行比较。我们应该能够适应/窃取其中的一些内容以在Word中工作。

CanAccessVBOM()中的注册表检查与安全设置中的"对Visual Basic Project的信任访问"相对应。

Sub ExportCode()

    If Not CanAccessVBOM Then Exit Sub ' Exit if access to VB object model is not allowed
    If (ThisWorkbook.VBProject.VBE.ActiveWindow Is Nothing) Then
        Exit Sub ' Exit if VBA window is not open
    End If
    Dim comp As VBComponent
    Dim codeFolder As String

    codeFolder = CombinePaths(GetWorkbookPath, "Code")
    On Error Resume Next
    MkDir codeFolder
    On Error GoTo 0
    Dim FileName As String

    For Each comp In ThisWorkbook.VBProject.VBComponents
        Select Case comp.Type
            Case vbext_ct_ClassModule
                FileName = CombinePaths(codeFolder, comp.Name & ".cls")
                DeleteFile FileName
                comp.Export FileName
            Case vbext_ct_StdModule
                FileName = CombinePaths(codeFolder, comp.Name & ".bas")
                DeleteFile FileName
                comp.Export FileName
            Case vbext_ct_MSForm
                FileName = CombinePaths(codeFolder, comp.Name & ".frm")
                DeleteFile FileName
                comp.Export FileName
            Case vbext_ct_Document
                FileName = CombinePaths(codeFolder, comp.Name & ".cls")
                DeleteFile FileName
                comp.Export FileName
        End Select
    Next

End Sub
Function CanAccessVBOM() As Boolean
    ' Check resgistry to see if we can access the VB object model
    Dim wsh As Object
    Dim str1 As String
    Dim AccessVBOM As Long

    Set wsh = CreateObject("WScript.Shell")
    str1 = "HKEY_CURRENT_USER\Software\Microsoft\Office\" & _
        Application.Version & "\Excel\Security\AccessVBOM"
    On Error Resume Next
    AccessVBOM = wsh.RegRead(str1)
    Set wsh = Nothing
    CanAccessVBOM = (AccessVBOM = 1)
End Function

Sub DeleteFile(FileName As String)
    On Error Resume Next
    Kill FileName
End Sub

Function GetWorkbookPath() As String
    Dim fullName As String
    Dim wrkbookName As String
    Dim pos As Long

    wrkbookName = ThisWorkbook.Name
    fullName = ThisWorkbook.fullName

    pos = InStr(1, fullName, wrkbookName, vbTextCompare)

    GetWorkbookPath = Left$(fullName, pos - 1)
End Function

Function CombinePaths(ByVal Path1 As String, ByVal Path2 As String) As String
    If Not EndsWith(Path1, "\") Then
        Path1 = Path1 & "\"
    End If
    CombinePaths = Path1 & Path2
End Function

Function EndsWith(ByVal InString As String, ByVal TestString As String) As Boolean
    EndsWith = (Right$(InString, Len(TestString)) = TestString)
End Function