这个主题在这里很好地涵盖了：
Pearson's Programming The VBA Editor

此代码

• 打开StrDir指定的目录中的所有xlsm文件（本例中为 C：\temp）
• 如果模块中至少有一行代码，则将每个代码组件导出到StrDir2（C：\mycode）指定的第二个目录
• 代码 *

Sub GetCode()
Dim WB As Workbook
Dim VBProj
Dim VBComp
Dim StrDir As String
Dim StrDir2 As String
Dim StrFile As String

StrDir = "c:\temp\"
StrDir2 = "c:\mycode\"

If Len(Dir(StrDir2, vbDirectory)) = 0 Then MkDir StrDir2
StrFile = Dir(StrDir & "*.xlsm")

With Application
.ScreenUpdating = False
.EnableEvents = False
End With

Do While Len(StrFile) > 0
    Set WB = Workbooks.Open(StrDir & StrFile, False)
    Set VBProj = WB.VBProject
        For Each VBComp In VBProj.vbcomponents
            If VBComp.codemodule.countoflines > 0 Then VBComp.Export StrDir2 & StrFile & "_" & VBComp.Name & ".txt"
        Next
    WB.Close False
StrFile = Dir
Loop

With Application
.ScreenUpdating = True
.EnableEvents = True
End With

End Sub

字符串

这是我的版本brettdj的代码缓慢通过word文档。其想法是使用类似WinMerge的东西来比较后续版本。
此版本在Excel中运行，但在Word文档上操作。（Excel是一个比Word更好和更宽松的Excel环境）。请确保在项目引用中引用“Microsoft Word 16.0 Object Library”（或任何版本）。
另一个区别是，在这个例子中，它期望一个干净的“转储”文件，然后为每个文档生成的每个文件集创建子目录。注意，还有一些.frm文件，这些文件不完全是临时文本编辑器可读的。

Option Explicit

Public Sub GetCode()
    Dim Doc As Word.Document
    Dim VBProj
    Dim VBComp
    Dim dir1 As String: dir1 = "C:\Users\Ralph\AppData\Roaming\Microsoft\Word\STARTUP\"
    Dim dir2 As String: dir2 = "C:\Users\Ralph\AppData\Roaming\Microsoft\Word\STARTUP\Dump\"
    Dim dir3 As String
    Dim file As String
    Dim fn As String
    Dim n As String

    If Len(Dir(dir2, vbDirectory)) = 0 Then MkDir dir2
    file = Dir(dir1 & "*.dotm")
    ' Application.ScreenUpdating = False
    ' Application.EnableEvents = False

    Do While Len(file) > 0
        Set Doc = Word.Documents.Open(dir1 & file, False)
        Set VBProj = Doc.VBProject
            For Each VBComp In VBProj.vbcomponents
                If VBComp.codemodule.countoflines > 0 Then
                    dir3 = dir2 & Replace(file, ".dotm", "") ' new subdirectory, get rid of .dotm
                    On Error Resume Next
                    MkDir dir3
                    On Error GoTo 0
                    n = VBComp.Name
                    fn = dir3 & "\" & n & ".txt"  ' the actual file name
                    VBComp.Export fn  ' exports the code and (pesky) .frx files
                End If
            Next
        Doc.Close False
    file = Dir
    Loop

    ' Application.ScreenUpdating = True
    ' Application.EnableEvents = True

End Sub

字符串