以程式方式從 Word 2007 文件中提取宏 (VBA) 程式碼

是否可以使用 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 等 - 所以這可能不是辦公室附帶的。

此外，您必須專門啟用對 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 編輯器保存，它就會將所有程式碼導出到文本文件中。我把文本文件放在顛覆中，這樣我就可以做差異了。您應該能夠調整/竊取其中的一些內容以在 Word 中工作。

CanAccessVBOM() 中的系統資料庫檢查對應於安全設置中的“信任對 Visual Basic 項目的訪問”。

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

引用自：https://stackoverflow.com/questions/49724