vba - How to get the procedure or function name at runtime?

Question

Is there any way to return the name of a function or procedure at runtime?

I'm currently error handling something like this:

Sub foo()
Const proc_name as string = "foo"
On Error GoTo ErrHandler

    ' do stuff

ExitSub:
    Exit Sub
ErrHandler:
    ErrModule.ShowMessageBox "ModuleName",proc_name
    Resume ExitSub
End Sub

I recently experienced one of my constants lying to me after I updated a function name, but not the constant value. I want to return the name of the procedure to my error handler.

I know that I will have to interact with the VBIDE.CodeModule object to find it. I've done a little bit of meta-programming with the Microsoft Visual Basic for Applications Extensibility library, but I've not had any success with doing this at runtime. I don't have my previous attempts, and before I dig my heels in to try this again, I want to know if it's even remotely possible.

Things that won't work

1. Using some built in VBA Library to access the call stack. It doesn't exist.
2. Implementing my own call stack by pushing and popping procedure names from an array as I enter and exit each one. This still requires that I pass the proc name somewhere else as a string.
3. A third party tool like vbWatchDog. This does work, but I can't use a third party tool for this project.

Note

vbWatchdog seems to do this by directly accessing the kernel memory via API calls.

Answer 1

I am not quite sure how helpful this is going to be...

The good thing is that you will not have to worry about the sub/function name - you are free to change it. All you have to care about is the uniqueness of the error handler label name.

For example

if you can avoid duplicate error handler labels in different subs/functions

don't do ?????

Sub Main()
    On Error GoTo ErrHandler
    Debug.Print 1 / 0

ErrHandler:
    Debug.Print "handling error in Main"
    SubMain
End Sub

Sub SubMain()
    On Error GoTo ErrHandler
    Debug.Print 1 / 0

ErrHandler:
    Debug.Print "handling error in SubMain"
End Sub

then the below code should work.

Note: I haven't been able to test it thoroughly but I am sure you can tweak it and get it work if it's of any help.

Note: Add references to Visual Basic for Applications Extensibility 5.3 via Tools -> References in VBE

Sub Main()

    ' additionally, this is what else you should do:
    ' write a Boolean function that checks if there are no duplicate error handler labels
    ' this will ensure you don't get a wrong sub/fn name returned

    Foo
    Boo

End Sub


Function Foo()

    ' remember to set the label name (handlerLabel) in the handler
    ' each handler label should be unique to avoid errors
    On Error GoTo FooErr
    Cells(0, 1) = vbNullString ' cause error deliberately

FooErr:

    Dim handlerLabel$
    handlerLabel = "FooErr" ' or don't dim this and pass the errHandler name directly to the GetFnOrSubName function

    Debug.Print "Error occured in " & Application.VBE.ActiveCodePane.CodeModule.Name & ": " & GetFnOrSubName(handlerLabel)

End Function


Sub Boo()

    On Error GoTo BooErr
    Cells(0, 1) = vbNullString ' cause error deliberately

BooErr:

    Debug.Print "Error occured in " & Application.VBE.ActiveCodePane.CodeModule.Name & ": " & GetFnOrSubName("BooErr")

End Sub

' returns CodeModule reference needed in the GetFnOrSubName fn
Private Function GetCodeModule(codeModuleName As String) As VBIDE.CodeModule
    Dim VBProj As VBIDE.VBProject
    Dim VBComp As VBIDE.VBComponent

    Set VBProj = ThisWorkbook.VBProject
    Set VBComp = VBProj.VBComponents(codeModuleName)

    Set GetCodeModule = VBComp.CodeModule
End Function

' returns the name of the sub where the error occured
Private Function GetFnOrSubName$(handlerLabel$)

    Dim VBProj As VBIDE.VBProject
    Dim VBComp As VBIDE.VBComponent
    Dim CodeMod As VBIDE.CodeModule

    Set VBProj = ThisWorkbook.VBProject
    Set VBComp = VBProj.VBComponents(Application.VBE.ActiveCodePane.CodeModule.Name)
    Set CodeMod = VBComp.CodeModule

    Dim code$
    code = CodeMod.Lines(1, CodeMod.CountOfLines)

    Dim handlerAt&
    handlerAt = InStr(1, code, handlerLabel, vbTextCompare)

    If handlerAt Then

        Dim isFunction&
        Dim isSub&

        isFunction = InStrRev(Mid$(code, 1, handlerAt), "Function", -1, vbTextCompare)
        isSub = InStrRev(Mid$(code, 1, handlerAt), "Sub", -1, vbTextCompare)

        If isFunction > isSub Then
            ' it's a function
            GetFnOrSubName = Split(Mid$(code, isFunction, 40), "(")(0)
        Else
            ' it's a sub
            GetFnOrSubName = Split(Mid$(code, isSub, 40), "(")(0)
        End If

    End If

End Function