How to get the procedure or function name at runtime?

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 / 0ErrHandler:    Debug.Print "handling error in Main"    SubMainEnd SubSub SubMain()    On Error GoTo ErrHandler    Debug.Print 1 / 0ErrHandler:    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    BooEnd SubFunction 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 deliberatelyFooErr:    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 FunctionSub Boo()    On Error GoTo BooErr    Cells(0, 1) = vbNullString ' cause error deliberatelyBooErr:    Debug.Print "Error occured in " & Application.VBE.ActiveCodePane.CodeModule.Name & ": " & GetFnOrSubName("BooErr")End Sub' returns CodeModule reference needed in the GetFnOrSubName fnPrivate 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.CodeModuleEnd Function' returns the name of the sub where the error occuredPrivate 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 IfEnd Function

I use a linked node based stack class wrapped in a singleton, globally instanced (done through Attributes) CallStack class. It allows me to perform error handling like David Zemens suggests (saving the procedure name each time):

Public Sub SomeFunc()    On Error Goto ErrHandler    CallStack.Push "MyClass.SomeFunc"    '... some code ...    CallStack.Pop()    Exit SubErrHandler:    'Use some Ifs or a Select Case to handle expected errors    GlobalErrHandler() 'Make a global error handler that logs the entire callstack to a file/the immediate window/a table in Access.End Sub

If it would be helpful to the discussion, I can post the associated code. The CallStack class has a Peek method to find out what the most recently called function is and a StackTrace function to get a string output of the entire stack.

More specifically to your question, I've always been interested in using VBA Extensibility to add the boiler-plate error handling code (as above) automatically. I've never gotten around to actually doing it, but I believe it's quite possible.

The following does not exactly answer my question, but it does solve my problem. It will need to be run during development prior to publishing the application.

My workaround relies on the fact that all of my constants are named the same because I am using CPearson's code to insert the constants into my procedures during development.

The VBIDE library doesn't support procedures well, so I wrapped them up in a class module named vbeProcedure.

' Class: vbeProcedure' requires Microsoft Visual Basic for Applications Extensibility 5.3 library' Author: Christopher J. McClellan' Creative Commons Share Alike and Attribute license'   http://creativecommons.org/licenses/by-sa/3.0/Option Compare DatabaseOption ExplicitPrivate Const vbeProcedureError As Long = 3500Private mParentModule As CodeModulePrivate isParentModSet As BooleanPrivate mName As StringPrivate isNameSet As BooleanPublic Property Get Name() As String    If isNameSet Then        Name = mName    Else        RaiseObjectNotIntializedError    End IfEnd PropertyPublic Property Let Name(ByVal vNewValue As String)    If Not isNameSet Then        mName = vNewValue        isNameSet = True    Else        RaiseReadOnlyPropertyError    End IfEnd PropertyPublic Property Get ParentModule() As CodeModule    If isParentModSet Then        Set ParentModule = mParentModule    Else        RaiseObjectNotIntializedError    End IfEnd PropertyPublic Property Let ParentModule(ByRef vNewValue As CodeModule)    If Not isParentModSet Then        Set mParentModule = vNewValue        isParentModSet = True    Else        RaiseReadOnlyPropertyError    End IfEnd PropertyPublic Property Get StartLine() As Long    If isParentModSet And isNameSet Then        StartLine = Me.ParentModule.ProcStartLine(Me.Name, vbext_pk_Proc)    Else        RaiseObjectNotIntializedError    End IfEnd PropertyPublic Property Get EndLine() As Long    If isParentModSet And isNameSet Then        EndLine = Me.StartLine + Me.CountOfLines    Else        RaiseObjectNotIntializedError    End IfEnd PropertyPublic Property Get CountOfLines() As Long    If isParentModSet And isNameSet Then        CountOfLines = Me.ParentModule.ProcCountLines(Me.Name, vbext_pk_Proc)    Else        RaiseObjectNotIntializedError    End IfEnd PropertyPublic Sub initialize(Name As String, codeMod As CodeModule)    Me.Name = Name    Me.ParentModule = codeModEnd SubPublic Property Get Lines() As String    If isParentModSet And isNameSet Then        Lines = Me.ParentModule.Lines(Me.StartLine, Me.CountOfLines)    Else        RaiseObjectNotIntializedError    End IfEnd PropertyPrivate Sub RaiseObjectNotIntializedError()    Err.Raise vbObjectError + vbeProcedureError + 10, CurrentProject.Name & "." & TypeName(Me), "Object Not Initialized"End SubPrivate Sub RaiseReadOnlyPropertyError()    Err.Raise vbObjectError + vbeProcedureError + 20, CurrentProject.Name & "." & TypeName(Me), "Property is Read-Only after initialization"End Sub

Then I added a function to my DevUtilities module (that's important later) to create a vbeProcedure object and return a collection of them.

Private Function getProcedures(codeMod As CodeModule) As Collection''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''    Returns collection of all vbeProcedures in a CodeModule      ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''    Dim StartLine As Long    Dim ProcName As String    Dim lastProcName As String    Dim procs As New Collection    Dim proc As vbeProcedure    Dim i As Long    ' Skip past any Option statement    '   and any module-level variable declations.    StartLine = codeMod.CountOfDeclarationLines + 1    For i = StartLine To codeMod.CountOfLines        ' get procedure name        ProcName = codeMod.ProcOfLine(i, vbext_pk_Proc)        If Not ProcName = lastProcName Then            ' create new procedure object            Set proc = New vbeProcedure            proc.initialize ProcName, codeMod            ' add it to collection            procs.Add proc            ' reset lastProcName            lastProcName = ProcName        End If    Next i    Set getProcedures = procsEnd Function

Next I loop through each procedure in a given code module.

Private Sub fixProcNameConstants(codeMod As CodeModule)    Dim procs As Collection    Dim proc As vbeProcedure    Dim i As Long 'line counter    'getProcName codeMod    Set procs = getProcedures(codeMod)    For Each proc In procs        With proc            ' skip the proc.StartLine            For i = .StartLine + 1 To .EndLine                ' find constant PROC_NAME declaration                If InStr(1, .ParentModule.Lines(i, 1), "Const PROC_NAME", vbTextCompare) Then                    'Debug.Print .ParentModule.Lines(i, 1)                    ' replace this whole line of code with the correct declaration                    .ParentModule.ReplaceLine i, "Const PROC_NAME As String = " & Chr(34) & .Name & Chr(34)                    'Debug.Print .ParentModule.Lines(i, 1)                    Exit For                End If            Next i        End With    Next procEnd Sub

Finally calling that sub for each code module in my active project (so long as it isn't my "DevUtilities" module).

Public Sub FixAllProcNameConstants()    Dim prj As vbProject    Set prj = VBE.ActiveVBProject    Dim codeMod As CodeModule    Dim vbComp As VBComponent    For Each vbComp In prj.VBComponents        Set codeMod = vbComp.CodeModule        ' don't mess with the module that'c calling this        If Not codeMod.Name = "DevUtilities" Then            fixProcNameConstants codeMod        End If    Next vbCompEnd Sub

I'll come back if I ever figure out what kind of sorcery vbWatchDog is using to expose the vba call stack.