单独导出VBA程序（子/功能）

在这个项目中，我所有的代码都在模块中，每个模块都有不同数量的过程。我正在尝试将VBA代码过程逐个导出到以其各自模块命名的文件夹中。我已经有了导出整个模块的代码，但我喜欢这个模块的挑战，用这种方式跟踪更改更有趣

下面的导出代码适用于除自身之外的每个模块，因为我检查函数/子模块的开始和结束的方式。这是一个循环问题，因为它认为检查中的短语是新子模块的开始

如果有人有一个更具创造性的解决方案来标记一个函数或子函数的开始和结束，将在这里工作，或有一个方法来调整我的，我会非常感激

Sub ExportVBCode2()

    'NOTE: Globals will be included with the first procedure exported, not necessarily the procedure(s) they're used in

    Dim directory As String
    directory = "C:\Users\Public\Documents\VBA Exports" & "\"

    Dim fso As Object
    Set fso = CreateObject("scripting.filesystemobject")

'    If fso.FolderExists(Left(directory, Len(directory) - 1)) Then
'        fso.deletefolder Left(directory, Len(directory) - 1)
'    End If

    If Len(Dir(directory, vbDirectory)) = 0 Then
        MkDir directory
    End If

    Dim VBComponent As Object
    Dim Fileout As Object
    Dim i As Long

    Dim currLine As String
    Dim currLineLower As String
    Dim functionString As String

    Dim functionName As String
    Dim funcOrSub As String

    For Each VBComponent In ThisWorkbook.VBProject.VBComponents
        If VBComponent.Type = 1 Then    'Component Type 1 is "Module"

            If Len(Dir(directory & "\" & VBComponent.Name & "\", vbDirectory)) = 0 Then
                MkDir directory & VBComponent.Name
            End If

            For i = 1 To VBComponent.CodeModule.CountOfLines
                currLine = RTrim$(VBComponent.CodeModule.Lines(i, 1))
                currLineLower = LCase$(currLine)


                'TODO need a more clever solution for the if check below, because it catches ITSELF. Maybe regex ?

                If (InStr(currLineLower, "function ") > 0 Or InStr(currLineLower, "sub ") > 0) And InStr(currLineLower, "(") > 0 And InStr(currLineLower, ")") > 0 Then
                    'this is the start of a new function

                    Select Case InStr(currLineLower, "function ")
                        Case Is > 0
                            funcOrSub = "function"
                        Case Else
                            funcOrSub = "sub"
                    End Select

                    functionName = Mid(currLine, InStr(currLineLower, funcOrSub) + Len(funcOrSub & " "), InStr(currLine, "(") - InStr(currLineLower, funcOrSub) - Len(funcOrSub & " "))
                End If

                functionString = functionString & currLine & vbCrLf

                If Trim$(currLineLower) = "end sub" Or Trim$(currLineLower) = "end function" Then
                    'this is the end of a function

                    Set Fileout = fso.CreateTextFile(directory & "\" & VBComponent.Name & "\" & functionName & ".txt", True, True)

                    Fileout.Write functionString
                    Fileout.Close

                    functionString = ""
                    functionName = ""
                End If
            Next i

        End If
    Next VBComponent

End Sub

---

我认为问题的关键是检查行中是否包含术语“function”，函数名后是否还包含左括号。例如：

Private Function foo（

。因此，在下一个空格或逗号字符之前，您需要计算1个空格字符和至少1个左括号。

您有一个“fun”的定义，这与我们使用的；-）…无论如何，因为您在所有行中循环，使用

CodeModule.ProcOfLine

可以更有效地获取给定行中的过程，确定这是您尚未处理的过程（还是您希望跳过的过程），然后使用

procstartine

和

ProcCountOfLines

和

GetLines

一次抓取整个过程，并将

i

迭代器向前跳过那么多行。将成为游戏规则的改变者顺便说一句；-）。。。如果你不知道任何C#，请不要担心，许多贡献者都在用它制作他们的C#牙齿！添加要查找的唯一注释字符串。如果在一行中对其本身执行此操作，则可以检查

“

是否是修剪字符串中的第一个字符。还有一个结束的唯一注释行（可能是匹配的），只是让它忽略注释行之间的代码行。@Mistella是的，这是一个创造性的方法，我绝对可以做到work@T.M.哈哈，今天当我回头看这个答案的时候，我只是在想。非常感谢。