5

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
8
  • forehead slap yep, that WOULD make it really easy, wouldn't it? Back to the drawing board it seems :) Jun 5, 2018 at 20:06
  • @MathieuGuindon by the way, I really love Rubberduck - wish i could put it onto my machine at work! Jun 5, 2018 at 20:08
  • 1
    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 5, 2018 at 21:08
  • 1
    @Mistella yeah, that's a creative approach that I could definitely make work Jun 6, 2018 at 0:11
  • 1
    @T.M. LOL i was just thinking that today when I looked back at that answer. thank you Aug 27, 2018 at 17:27

1 Answer 1

0

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.

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

Not the answer you're looking for? Browse other questions tagged or ask your own question.