How to get the procedure or function name at runtime?
Asked Answered
G

5

24

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.

Gabbi answered 30/5, 2014 at 0:42 Comment(10)
I looked in to this a few months ago and arrived at the result that either it was not possible, or it was not something that my Google-fu could find. The OnError GoTo... raises the error in calling procedure (not the procedure where error occurs, and the call stack is not exposed to you through VBA, the best I could do was to use a global string variable and assign the "active" procedure name at the start of each proc. Not perfect because a sub may call on multiple procedures before returning to error in the "main" sub (without re-assigning the string), but close enough for my needs.Metaphase
That's a good idea @DavidZemens. I might try that it seems an awful lot simpler than messing with the extensibility library. Tons less overhead too. Thanks.Gabbi
See also: cpearson.com/excel/InsertProcedureNames.aspx which confirms "In VBA, there is no way to determine programmatically the name of the currently running procedure. That is, there is no way for a procedure to get its own name. Such a feature would be very useful when generating debug and diagnostic reports"... And goes on to describe something similar to what I mention above. Ultimately I don't think ti's very useful unless each procedure has its own error-handling because of the limitation I cited above :)Metaphase
@DavidZemens that's exactly what I used to insert the proc names and, by dissecting the code, how I learned to meta-program in vba. You might find this tool of interest. Unfortunately, I'm unable to use it for this project. If I come up with a real solution I'll be sure to ping you.Gabbi
potentially useful for sure -- the real reason I was after something like this is to generate more robust error logs from applications deployed on other user's machines. This claims to do just that :) PowerPoint in particular does not let you "break" and enter debug mode without a registry hack, so getting a detailed log of where the error happened would be very helpful... but that reminds me, you can (conceivably) create registry keys from VBA, I've seen it recently. I should look in to that...Metaphase
We're getting chatty now, but I recently -hacked- err... Improved Steve McMahon's registry class so that it works in vba. Added a couple of routines to it. My version on google drive. I wrote a DSN Class on top of it.Gabbi
@ckuhn203 would it be safe to make one assumption that all the error handlers labels will be unique? ie. this won't happenDowngrade
You may @mehow in the interest of a solution, but I do use VBIDE to insert them exactly like that.Gabbi
@ckuhn203 there are 2 possible solutions - I am working on the unique error handler labels now and should have this ready within an hour, the other option is to use Erl function but this requires you to explicitly number the linesDowngrade
@ckuhn203 I couldn't get the Erl method to work. Even if I numbered the lines like 999 On Error GoTo <label> the Erl function would return 999 but the CodeMod.Find() wouldn't compute with the value 999 as it literally looks at line 999 instead of the one aliased 999 :(Downgrade
D
7

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
Downgrade answered 30/5, 2014 at 12:10 Comment(6)
A for effort. It won't lie, but man that would be a nightmare to maintain.Gabbi
@ckuhn203 not sure why this would be a nightmare? All it takes is to get the unique labels and pass it as parameter.Downgrade
That's exactly why. I think it will be all right. I would just have to update my insertErrorHandling() routines to grab the procedure name to create the..... error label name. Kind of back to square one unless I'm missing something. Am I?Gabbi
I'm going to accept your answer as it came closest to my requirements.Gabbi
Application.VBE.ActiveCodePane.CodeModule.Name returns the name of the module that's currently open in VBA editor, not the one that is currently executing.Degeneration
Application.VBE.ActiveCodePane may not be activated and causes the application to behave strangely (e.g. errors where the Err object is not available :-( ) sometimes. To activate use VBE.ActiveVBProject.VBComponents("Module1").Activate. See here for details: https://mcmap.net/q/583691/-why-doesn-39-t-vbe-activecodepane-codemodule-work-when-the-vbe-code-window-isn-39-t-openBatruk
B
5

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 Sub

ErrHandler:
    '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.

Bushire answered 30/5, 2014 at 14:19 Comment(4)
Again, we're manually maintaining a string that can lie if it's improperly entered or failed to maintained. I'm coming to the conclusion this can't be done with "vba". vbWatchDog seems to accomplish it by accessing the kernel memory directly, but I just don't understand how that works. I'm working on a utility that will correct my proc_name constant if it doesn't match the actual procedure name.Gabbi
It's absolutely possible. I use the extensibility library to put my boiler plate error handling in my modules.Gabbi
@ckuhn203 Interesting reading. I can imagine that COM introspection might allow the possibility of finding the names of classes and members, but probably not the active VBA function :(Bushire
That is some interesting reading. I need to find some time to digest it a bit.Gabbi
G
3

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 Database
Option Explicit

Private Const vbeProcedureError As Long = 3500

Private mParentModule As CodeModule
Private isParentModSet As Boolean
Private mName As String
Private isNameSet As Boolean

Public Property Get Name() As String
    If isNameSet Then
        Name = mName
    Else
        RaiseObjectNotIntializedError
    End If
End Property

Public Property Let Name(ByVal vNewValue As String)
    If Not isNameSet Then
        mName = vNewValue
        isNameSet = True
    Else
        RaiseReadOnlyPropertyError
    End If
End Property

Public Property Get ParentModule() As CodeModule
    If isParentModSet Then
        Set ParentModule = mParentModule
    Else
        RaiseObjectNotIntializedError
    End If
End Property

Public Property Let ParentModule(ByRef vNewValue As CodeModule)
    If Not isParentModSet Then
        Set mParentModule = vNewValue
        isParentModSet = True
    Else
        RaiseReadOnlyPropertyError
    End If
End Property

Public Property Get StartLine() As Long
    If isParentModSet And isNameSet Then
        StartLine = Me.ParentModule.ProcStartLine(Me.Name, vbext_pk_Proc)
    Else
        RaiseObjectNotIntializedError
    End If
End Property

Public Property Get EndLine() As Long
    If isParentModSet And isNameSet Then
        EndLine = Me.StartLine + Me.CountOfLines
    Else
        RaiseObjectNotIntializedError
    End If
End Property

Public Property Get CountOfLines() As Long
    If isParentModSet And isNameSet Then
        CountOfLines = Me.ParentModule.ProcCountLines(Me.Name, vbext_pk_Proc)
    Else
        RaiseObjectNotIntializedError
    End If
End Property

Public Sub initialize(Name As String, codeMod As CodeModule)
    Me.Name = Name
    Me.ParentModule = codeMod
End Sub

Public Property Get Lines() As String
    If isParentModSet And isNameSet Then
        Lines = Me.ParentModule.Lines(Me.StartLine, Me.CountOfLines)
    Else
        RaiseObjectNotIntializedError
    End If
End Property

Private Sub RaiseObjectNotIntializedError()
    Err.Raise vbObjectError + vbeProcedureError + 10, CurrentProject.Name & "." & TypeName(Me), "Object Not Initialized"
End Sub

Private 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 = procs

End 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 proc
End 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 vbComp
End Sub

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

Gabbi answered 30/5, 2014 at 17:31 Comment(2)
vbWatchdog injects precompiled code into the memory and uses as an classobject. Since the Author knows how to decompile compiled VBA he gets the proc_name and other information from the compiled code. Also i guess, since he knows how to decompile, he actually modifies the error part so his procedure can be called as soon as any error hits system level. PErsonally i would love to see your process.Meit
@krishKM I eventually figured that much out, but haven't been able to replicate vbWatchdog's functionality. So, besides some improvements to the classes here, this is exactly what I do. It's a bit ugly. Lots of boiler plate and it takes a bit of thought about where exactly an error should be reported from. If you're interested in the current state of the classes I mentioned here, the updated versions are in my VBEX repo on Github, but the code I use to fix up my projects unfortunately isn't.Gabbi
D
2

Use Err.Raise

For the Source parameter pass in:

Me.Name & "." & Application.VBE.ActiveCodePane.CodeModule.ProcOfLine(Application.VBE.ActiveCodePane.TopLine, 0)
Denary answered 26/5, 2017 at 17:21 Comment(1)
Me.Name does not work, not even in class modules. the rest will return the method name. if ActiveCodePane is not initialized see #23945821Batruk
S
0

Had exactly the same issue for years. I solved this issue by declaring a public variable of type string, in which is inserted the name of module and procedure at the beginning of each procedure.

On error, I display this string. Because I use template for all new procedures, I rarely forget to edit my input to error string

The benefit of doing so is that I see approximately 6 routines (from top to bottom, latest to earliest) that were executed.

in template code, seen below, I edit "private sub" to suit my needs and adjust the routine name. Then I enter module name and routine name to the line where error string is updated.

Public errS As String

Private Sub Template()
'macro description
errS = VBA.left(vbLf & "-> " & "mod99_Template.Template" & VBA.Replace(errS, "->", "    "), IIf(VBA.InStr(140, errS, vbLf, vbTextCompare) = 0, 280, VBA.InStr(140, errS, vbLf, vbTextCompare)))
'    Application.Run "'" & ThisWorkbook.Name & "'!mod99_Template.Template"
'Dim StartTime As Double:       StartTime = Timer   'Timer
Application.ScreenUpdating = False
'############################    PARAMETRI    ##########################################
'############################     PROGRAM     ##########################################
    On Error GoTo ExitProc
    Dim wbA As Workbook:    Set wbA = ActiveWorkbook
    Dim wsA As Worksheet:   Set wsA = Sheet1 'Sheet1 / wbA.Sheets(shtPregled) / wbA.ActiveSheet

    With wsA
    
    End With
    
ExitProc:
    If Err.Number <> 0 Then MsgBox "Error occured in: " & errS & vbLf & vbLf & Err.Description: Err.Clear:  Stop
    Set wsA = Nothing
    Set wbA = Nothing
Application.ScreenUpdating = True
'MsgBox "This code ran successfully in " & Round(Timer - StartTime, 2) & " seconds", vbInformation    'Timer
End Sub

It is not the best solution for sure, but it is simple and works well when running on a VBE protected workbooks.

Study answered 24/7 at 12:46 Comment(0)

© 2022 - 2024 — McMap. All rights reserved.