Export VBA Procedures (Sub/Function) Separately

Question

In the project I'm working on all of my code is in modules which each have a varying number of procedures. I'm trying to export VBA code procedures one by one into folders named after their respective module. I already have code to export whole modules but I like the challenge of this one and it's more fun to track changes this way!

The export code below works for every module except itself because of the way that I check for the start and end of a function/sub. It's a circular problem, really, because it thinks the phrases from the checks are the start of a new sub!

If anyone has a more creative solution for marking the beginning and end of a function or sub that will work here or has a way to tweak mine I would really appreciate it!

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

*forehead slap* yep, that WOULD make it really easy, wouldn't it? Back to the drawing board it seems :) — Marcucciboy2, Jun 05 '18 at 20:06
@MathieuGuindon by the way, I really love Rubberduck - wish i could put it onto my machine at work! — Marcucciboy2, Jun 05 '18 at 20:08
Add a unique comment string to look for. If you do it in a line to itself, you can check if `'` is the first character in the trimmed string. Have a closing unique comment line as well (maybe matching) and just have it ignore the lines of code in between those comment lines. — Mistella, Jun 05 '18 at 21:08
@Mistella yeah, that's a creative approach that I could definitely make work — Marcucciboy2, Jun 06 '18 at 00:11
@Marcucciboy2 - think you might profit of some code in helper function `getErrLine()` at [VBA error handler that emails me when errors occur](https://stackoverflow.com/questions/51895607/vba-error-handler-that-emails-me-when-errors-occur/52035103#52035103). — T.M., Aug 27 '18 at 17:25
@T.M. LOL i was just thinking that today when I looked back at that answer. thank you — Marcucciboy2, Aug 27 '18 at 17:27
@Marcucciboy2, no, not in active ones, but was interested in non resolved questions referring to VBE modules. BTW I have fun, too searching for innovative solutions - c.f. your comment to [Pick a winner](https://stackoverflow.com/questions/51891756/pick-a-winner-of-scores-from-a-row-in-excel-with-multiple-winners/51894167#51894167) — T.M., Aug 27 '18 at 17:42

score 0 · Answer 1 · answered Oct 13 '18 at 09:57

I think the key to the problem is to check if the line contains the term "function" contains also a left parenthesis after the function name. For example: Private Function foo(. So you expect to count 1 space character and at least 1 left parenthesis before the next space or comma character.

Export VBA Procedures (Sub/Function) Separately

1 Answers1