Экспорт процедур VBA (подфункция / функция) отдельно

Question

В проекте, над которым я работаю, весь мой код состоит из модулей, каждый из которых имеет различное количество процедур.Я пытаюсь экспортировать процедуры кода 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

Answer 1

Я думаю, что ключом к проблеме является проверка того, содержит ли строка термин «функция» также левую скобку после имени функции.Например: Private Function foo(.Таким образом, вы ожидаете посчитать 1 пробел и как минимум 1 левую скобку перед следующим пробелом или запятой.