Get Name of Current VBA Function

Question

For error handling code, I would like to get the name of the current VBA function (or sub) that the error occurred in. Does anyone know how this could be done?

[EDIT] Thanks all, I had hoped that an undocumented trick existed to self-determine the function, but that obviously doesn't exist. Guess I'll stay with my current code:

Option Compare Database: Option Explicit: Const cMODULE$ = "basMisc"

Public Function gfMisc_SomeFunction$(target$)
On Error GoTo err_handler: Const cPROC$ = "gfMisc_SomeFunction"
    ...
exit_handler:
    ....
    Exit Function
err_handler:
    Call gfLog_Error(cMODULE, cPROC, err, err.Description)
    Resume exit_handler
End Function

score 17 · Answer 1 · edited May 23 '17 at 12:09

There's nothing to get the current function name, but you can build a fairly lightweight tracing system using the fact that VBA object lifetimes are deterministic. For example, you can have a class called 'Tracer' with this code:

Private proc_ As String

Public Sub init(proc As String)
    proc_ = proc
End Sub

Private Sub Class_Terminate()
    If Err.Number <> 0 Then
        Debug.Print "unhandled error in " & proc_
    End If
End Sub

and then use that class in routines like:

Public Sub sub1()
    Dim t As Tracer: Set t = New Tracer
    Call t.init("sub1")

    On Error GoTo EH

    Call sub2

    Exit Sub

EH:
    Debug.Print "handled error"
    Call Err.Clear
End Sub

Public Sub sub2()
    Dim t As Tracer: Set t = New Tracer
    Call t.init("sub2")

    Call Err.Raise(4242)
End Sub

If you run 'sub1', you should get this output:

unhandled error in sub2
handled error

because your Tracer instance in 'sub2' was deterministically destroyed when the error caused an exit from the routine.

This general pattern is seen a lot in C++, under the name "RAII", but it works just fine in VBA too (other than the general annoyance of using classes).

EDIT:

To address David Fenton's comment that this is a relatively complicated solution to a simple problem, I don't think the problem is actually that simple!

I'm taking it for granted that we all agree that we don't want to give every single routine in our VBA program its own error handler. (See my reasoning here: VBA Error "Bubble Up")

If some internal routines don't have their own error handlers, then when we do catch an error, all we know is that is happened in the routine with the error handler that fired or in a routine somewhere deeper in the call stack. So the problem as I understand it is really one of tracing the execution of our program. Tracing routine entry is easy of course. But tracing exit can indeed be quite complicated. For example, there might be an error that gets raised!

The RAII approach allows us to use the natural behavior of VBA object life management to recognize when we've exited a routine, whether through an 'Exit', 'End', or error. My toy example is just meant to illustrate the concept. The real "tracer" in my own little VBA framework is certainly more complex, but also does more:

Private Sub Class_Terminate()
    If unhandledErr_() Then
        Call debugTraceException(callID_, "Err unhandled on exit: " & fmtCurrentErr())
    End If

    If sendEntryExit_ Then
        Select Case exitTraceStatus_
            Case EXIT_UNTRACED
                Call debugTraceExitImplicit(callID_)
            Case EXIT_NO_RETVAL
                Call debugTraceExitExplicit(callID_)
            Case EXIT_WITH_RETVAL
                Call debugTraceExitExplicit(callID_, retval_)
            Case Else
                Call debugBadAssumption(callID_, "unrecognized exit trace status")
        End Select
    End If
End Sub

But using it is still pretty simple, and amounts to less boilerplate than the "EH in every routine" approach anyway:

Public Function apply(functID As String, seqOfArgs)
    Const PROC As String = "apply"
    Dim dbg As FW_Dbg: Set dbg = mkDbg(MODL_, PROC, functID, seqOfArgs)

...

Automatically generating the boilerplate is easy, although I actually type it in and then automatically check to make sure routine/arg names match as part of my tests.

Seems to me to be an awfully complicated solution to a relatively simple problem. — David-W-Fenton, Sep 25 '10 at 20:47
@David-W-Fenton, I'm not sure it's really that simple. See my edited answer for why I suggest this approach. I'd be interested to hear your own method. — jtolle, Sep 25 '10 at 23:30
I don't see the point of using a class-based approach where you instantiate an instance of the class for each subroutine, versus just maintaining a stack that you push/pop. The latter could be done with a single class. — David-W-Fenton, Sep 26 '10 at 19:17
@David-W-Fenton, right, but how are you supposed to know when to pop, especially when an error is raised? The whole point of an RAII approach is that you don't. VBA *already* maintains a stack, and already knows how to unwind it as an error gets raised and eventually handled in some error handler. You just instantiate an object and then forget about it; VBA destroys it exactly when the thing you want to track - procedure exit - happens. Doing all of that manually with error handlers in every routine that have to log and re-raise what they catch explicitly seems exhausting and error prone. — jtolle, Sep 27 '10 at 20:06
Because VBA uses reference counting for memory cleanup you absolutely CANNOT depend on it to clean up when objects go out of scope. VBA maintains a stack, but it's not exposed programmatically (dunno why). — David-W-Fenton, Sep 29 '10 at 00:29
I can't see the difference between having an error handler in every subroutine and instantiating a class in ever subroutine. And, of course, what I'm suggesting is *not* an error handler in each, but a different method of storing the stack, with a single storage structure (however you implement it), instead of the complexity of multiple instances of a class. — David-W-Fenton, Sep 29 '10 at 00:31
@David-W-Fenton, Good discussion - thanks. Re: the VBA GC, have you ever seen problems with classes you've written? I'm aware of problems related to Access/DAO object model classes from this SO post: http://stackoverflow.com/questions/517006/is-there-a-need-to-set-objects-to-nothing-inside-vba-functions, but not of general GC issues. Re: maintaining your own stack, it seems like you'd need to have an EH in every routine in order to know when to pop routines off (and of course explicit pop code at every exit point). How would you do it explicitly without an EH? Like I said, good discussion... — jtolle, Sep 29 '10 at 01:06
See also http://stackoverflow.com/questions/1525772/is-object-clearing-array-deallocation-really-necessary-in-vb6-vba-pros-cons — jtolle, Sep 29 '10 at 01:13
I have seen class-heavy Access apps that were very prone to code corruption, so I'm wary of using something that spawns so many instances of them and uses them in every subroutine. Also, there are known issues with certain things like On Error Resume Next not going out of scope and "eating" errors outside contexts it should be applicable, so even though these are not COM objects (the usual type of objects that need careful management), I'd still be wary. Also, there can be issues within Access VBA with implicit references that don't involve COM, so I'm not so sanguine about trusting scope. — David-W-Fenton, Sep 29 '10 at 20:50

score 7 · Answer 2 · answered Sep 25 '10 at 19:01

7

I use the error handler button within the free MZTools for VBA. It automatically adds the lines of code along with the sub/function name. Now if you rename the sub/function you have to remember to change the code.

MZTools has many nice functions built in as well. Such as an improved find screen and the best of all is a button showing you all the places where this sub/function is called.

answered Sep 25 '10 at 19:01

Tony Toews

7,850
1
22
27

Had a quick look at MZTools, one or two features look useful for me, thanks Tony. – maxhugen Sep 26 '10 at 01:46
2

Well I've been using MZ Tools for a year... so Tony, I am now using more than 1 or 2 features! As a long term Access programmer (with his own set of good/bad practices), MZT has become a 'must have' accessory :) Thanks! – maxhugen Aug 30 '11 at 10:25

score 5 · Answer 3 · answered Jun 25 '13 at 20:49

vbWatchdog is a commercial solution to the problem. It is very reasonably priced for its capabilities. Among other features it offers full access to the VBA call stack. I know of no other product that does this (and I've looked).

There are several other features including variable inspection and custom error dialog boxes, but the access to the stack trace alone is worth the price of admission.

NOTE: I am in no way affiliated with the product except that I am an extremely satisfied user.

score 5 · Answer 4 · answered May 26 '17 at 17:31

Seriously? Why do developers continue to solve the same problem over and over again? Send get the procedure name into the Err object using Err.Raise...

For the Source parameter pass in:

Me.Name & "." & Application.VBE.ActiveCodePane.CodeModule.ProcOfLine(Application.VBE.ActiveCodePane.TopLine, 0)

I know it's not the shortest one liner but if you can't afford a commercial product to enhance the VBA IDE or if, like many of us, are restricted to working in a locked down environment then this is the easiest solution.

p.campbell · Answer 5 · 2010-09-25T02:23:48.283

3

Not using any built-in VBA way. The best you'll be able to do is repeat yourself by hardcoding the method name as a constant or regular method-level variable.

Const METHOD_NAME = "GetCustomer"

 On Error Goto ErrHandler:
 ' Code

ErrHandler:
   MsgBox "Err in " & METHOD_NAME

You may be able to find something handy in the MZ Tools for VBA. It's a developer add-in for the VB family of languages. Written by an MVP.

edited Sep 25 '10 at 02:23

answered Sep 25 '10 at 02:16

p.campbell

98,673
67
256
322

1

Yep, pretty much what I've always done, see my edited post. Thanks. – maxhugen Sep 26 '10 at 01:40

score 3 · Answer 6 · answered Sep 25 '10 at 02:20

3

VBA doesn't have any built-in stack trace that you can access programatically. You'd have to design your own stack and push/pop onto that to accomplish something similar. Otherwise, you'll need to hard code your function/sub names into the code.

answered Sep 25 '10 at 02:20

KevenDenen

1,718
13
25

Yes, it does. But it has nothing to do with the question at hand. – KevenDenen Dec 31 '14 at 18:42
4

Application.Caller has nothing to do with a stack trace or knowing what function called the current function. Your comment is unrelated and unhelpful. – KevenDenen Jan 02 '15 at 17:42

Randall Porter · Answer 7 · 2016-06-30T00:10:20.010

2

This works for me. I am on 2010.

ErrorHandler:
    Dim procName As String
    procName = Application.VBE.ActiveCodePane.CodeModule.ProcOfLine(Application.VBE.ActiveCodePane.TopLine, 0)
    MyErrorHandler err, Me.Name, getUserID(), procName
    Resume Exithere

edited Jun 30 '16 at 00:10

answered Jul 16 '15 at 18:26

Randall Porter

33
5

I ended up using the MZ-Tools add-in (which I highly recommend), which can auto-insert my original error handling code in any function/sub - as per Tony Toews comments. – maxhugen Jul 16 '15 at 23:34
It is useful, but could be tricky because 'Application.VBE.ActiveCodePane.TopLine' returns the the line number of the line at the top of the code pane. So if you are in debug mode, the procName can be switched with the actual procedure. And instead of 'Me.Name' you should use 'Application.VBE.ActiveCodePane.CodeModule' directly. – Lionel T. Apr 10 '17 at 21:14

Vlado · Answer 8 · 2019-11-12T15:00:01.913

The code of sean hendrix is not bad at all. I improved it a little bit:

Public Function AddErrorCode(modName As String)
    Dim VBComp As Object
    Dim VarVBCLine As Long

    Set VBComp = Application.VBE.ActiveVBProject.VBComponents(modName)

    For VarVBCLine = 1 To VBComp.CodeModule.CountOfLines + 1000
        If UCase(VBComp.CodeModule.Lines(VarVBCLine, 1)) Like UCase("*Function *") Then
            If Not (VBComp.CodeModule.Lines(VarVBCLine + 1, 1) Like "On Error GoTo *") Then
                     VBComp.CodeModule.InsertLines VarVBCLine + 1, "On Error GoTo ErrHandler_"
                     VBComp.CodeModule.InsertLines VarVBCLine + 2, "    Dim VarThisName as String"
                     VBComp.CodeModule.InsertLines VarVBCLine + 3, "    VarThisName = """ & Trim(Mid(VBComp.CodeModule.Lines(VarVBCLine, 1), InStr(1, VBComp.CodeModule.Lines(VarVBCLine, 1), "Function") + Len("Function"), Len(VBComp.CodeModule.Lines(VarVBCLine, 1)))) & """"
                    VarVBCLine = VarVBCLine + 4
            End If
        End If
         If UCase(VBComp.CodeModule.Lines(VarVBCLine, 1)) Like UCase("*End Function*") Then
            If Not (VBComp.CodeModule.Lines(VarVBCLine - 1, 1) Like "*Resume '*") And Not (UCase(VBComp.CodeModule.Lines(VarVBCLine - 1, 1)) Like UCase("*Err.Raise*")) Then
                VBComp.CodeModule.InsertLines VarVBCLine, "ExitProc_:"
                VBComp.CodeModule.InsertLines VarVBCLine + 1, "    Exit Function"
                VBComp.CodeModule.InsertLines VarVBCLine + 2, "ErrHandler_:"
                VBComp.CodeModule.InsertLines VarVBCLine + 3, "    Call LogError(Err, Me.Name, VarThisName)"
                VBComp.CodeModule.InsertLines VarVBCLine + 4, "    Resume ExitProc_"
                VBComp.CodeModule.InsertLines VarVBCLine + 5, "    Resume ' use for debugging"
                VarVBCLine = VarVBCLine + 6
            End If
        End If

        If UCase(VBComp.CodeModule.Lines(VarVBCLine, 1)) Like UCase("*Private Sub *") Or UCase(VBComp.CodeModule.Lines(VarVBCLine, 1)) Like UCase("*Public Sub *") Then
            If Not (VBComp.CodeModule.Lines(VarVBCLine + 1, 1) Like "On Error GoTo *") Then
                     VBComp.CodeModule.InsertLines VarVBCLine + 1, "On Error GoTo ErrHandler_"
                     VBComp.CodeModule.InsertLines VarVBCLine + 2, "    Dim VarThisName as String"
                     VBComp.CodeModule.InsertLines VarVBCLine + 3, "    VarThisName = """ & Trim(Mid(VBComp.CodeModule.Lines(VarVBCLine, 1), InStr(1, VBComp.CodeModule.Lines(VarVBCLine, 1), "Sub") + Len("Sub"), Len(VBComp.CodeModule.Lines(VarVBCLine, 1)))) & """"
                    VarVBCLine = VarVBCLine + 4
            End If
        End If
         If UCase(VBComp.CodeModule.Lines(VarVBCLine, 1)) Like UCase("*End Sub*") Then
            If Not (VBComp.CodeModule.Lines(VarVBCLine - 1, 1) Like "*Resume '*") And Not (UCase(VBComp.CodeModule.Lines(VarVBCLine - 1, 1)) Like UCase("*Err.Raise*")) Then
                VBComp.CodeModule.InsertLines VarVBCLine, "ExitProc_:"
                VBComp.CodeModule.InsertLines VarVBCLine + 1, "    Exit Sub"
                VBComp.CodeModule.InsertLines VarVBCLine + 2, "ErrHandler_:"
                VBComp.CodeModule.InsertLines VarVBCLine + 3, "    Call LogError(Err, Me.Name, VarThisName)"
                VBComp.CodeModule.InsertLines VarVBCLine + 4, "    Resume ExitProc_"
                VBComp.CodeModule.InsertLines VarVBCLine + 5, "    Resume ' use for debugging"
                'VBComp.CodeModule.DeleteLines VarVBCLine + 5, 1
                'VBComp.CodeModule.ReplaceLine VarVBCLine + 5, "    Resume ' replaced"
                VarVBCLine = VarVBCLine + 6
            End If
        End If

    Next VarVBCLine

End Function

You can put it in a separate module and call it like this:

AddErrorCode "Form_MyForm"

in Immediate window. It will change your form code from this:

Private Sub Command1_Click()

    Call DoIt

End Sub

to this in all Procedures on of MyForm.

Private Sub Command1_Click()
On Error GoTo ErrHandler_
   Dim VarThisNameAs String
   VarThisName = "Command1_Click()"

        Call DoIt

ExitProc_:
    Exit Sub
ErrHandler_:
    Call LogError(Err, Me.Name, VarThisName)
    Resume ExitProc_
    Resume ' use for debugging
End Sub

You can run it repeatedly for the same form and it will not duplicate the code. You need to create a public sub to catch the errors and write the code to a file or DB to log it.

Public Sub LogError(ByVal objError As ErrObject, PasModuleName As String, Optional PasFunctionName As String = "")
    On Error GoTo ErrHandler_
    Dim sql As String
    ' insert the values into a file or DB here
    MsgBox "Error " & Err.Number & Switch(PasFunctionName <> "", " in " & PasFunctionName) & vbCrLf & " (" & Err.Description & ") ", vbCritical, Application.VBE.ActiveVBProject.Name
Exit_:
    Exit Sub
ErrHandler_:
    MsgBox "Error in LogError function " & Err.Number
    Resume Exit_
    Resume ' use for debugging
End Sub

Edit: Here is improved code:

Public Sub InsertErrHandling(modName As String)
    Dim Component As Object
    Dim Name As String
    Dim Kind As Long
    Dim FirstLine As Long
    Dim ProcLinesCount As Long
    Dim Declaration As String
    Dim ProcedureType As String
    Dim Index As Long, i As Long, j As Long
    Dim LastLine As Long
    Dim StartLines As Collection, LastLines As Collection, ProcNames As Collection, ProcedureTypes As Collection
    Dim gotoErr As Boolean

    Kind = 0
    Set StartLines = New Collection
    Set LastLines = New Collection
    Set ProcNames = New Collection
    Set ProcedureTypes = New Collection

    Set Component = Application.VBE.ActiveVBProject.VBComponents(modName)
        With Component.CodeModule

            ' Remove empty lines on the end of the code
            For i = .CountOfLines To 1 Step -1
                If Component.CodeModule.Lines(i, 1) = "" Then
                  Component.CodeModule.DeleteLines i, 1
                Else
                    Exit For
                End If
            Next i

            Index = .CountOfDeclarationLines + 1
            Do While Index < .CountOfLines
                gotoErr = False
                Name = .ProcOfLine(Index, Kind)
                FirstLine = .ProcBodyLine(Name, Kind)
                ProcLinesCount = .ProcCountLines(Name, Kind)
                Declaration = Trim(.Lines(FirstLine, 1))
                LastLine = FirstLine + ProcLinesCount - 2
                If InStr(1, Declaration, "Function ", vbBinaryCompare) > 0 Then
                    ProcedureType = "Function"
                Else
                    ProcedureType = "Sub"
                End If
               Debug.Print Component.Name & "." & Name, "First: " & FirstLine, "Lines:" & ProcLinesCount, "Last: " & LastLine, Declaration

                ' do not insert error handling if there is one already:
                For i = FirstLine To LastLine Step 1
                    If Component.CodeModule.Lines(i, 1) Like "*On Error*" Then
                        gotoErr = True
                        Exit For
                    End If
                Next i
                If Not gotoErr Then

                    StartLines.add FirstLine
                    LastLines.add LastLine
                    ProcNames.add Name
                    ProcedureTypes.add ProcedureType
                Else
                    Debug.Print Component.Name & "." & Name, "Existing Error handling"
                End If

                Index = FirstLine + ProcLinesCount + 1
            Loop

            For i = LastLines.Count To 1 Step -1
                If Not (Component.CodeModule.Lines(StartLines.Item(i) + 1, 1) Like "*On Error GoTo *") Then
                    If (Component.CodeModule.Lines(LastLines.Item(i) - 1, 1)) Like "*End " & ProcedureTypes.Item(i) Then
                        j = LastLines.Item(i) - 1
                    Else
                        j = LastLines.Item(i)
                    End If
                    Component.CodeModule.InsertLines j, "ExitProc_:"
                    Component.CodeModule.InsertLines j + 1, "    DoCmd.Hourglass False"
                    Component.CodeModule.InsertLines j + 2, "    Exit " & ProcedureTypes.Item(i)
                    Component.CodeModule.InsertLines j + 3, "ErrHandler_:"
                    Component.CodeModule.InsertLines j + 4, "    DoCmd.Hourglass False"
                    Component.CodeModule.InsertLines j + 5, "    Call LogError(Err.Number, Err.Description,  """ & modName & """, """ & ProcNames.Item(i) & """)"
                    Component.CodeModule.InsertLines j + 6, "    Resume ExitProc_"
                    Component.CodeModule.InsertLines j + 7, "    Resume ' use for debugging"

                    Component.CodeModule.InsertLines StartLines.Item(i) + 1, "    On Error GoTo ErrHandler_"
                    Debug.Print Component.Name & "." & ProcNames.Item(i), "First: " & StartLines.Item(i), "Last: " & j, "   Inserted"
                End If
            Next i
        End With
End Sub

I've been programming for 18 years and this is the first time I've ever seen the `Like` operator in VBScript. I simply did not know this even existed. *#YouCanAlwaysTeachAnOldDogNewTricks* — Drew Chapin, Mar 12 '19 at 16:41

score 0 · Answer 9 · answered Oct 24 '14 at 17:53

Code is ugly but it works. This example will add error handling code to each function that also contains a string with the function name.

Function AddErrorCode()
    Set vbc = ThisWorkbook.VBProject.VBComponents("Module1")
    For VarVBCLine = 1 To vbc.codemodule.CountOfLines + 1000
        If UCase(vbc.codemodule.Lines(VarVBCLine, 1)) Like UCase("*Function *") And Not (UCase(vbc.codemodule.Lines(VarVBCLine, 1)) Like UCase("*Function FunctionReThrowError*")) Then
            If Not (vbc.codemodule.Lines(VarVBCLine + 1, 1) Like "*Dim VarFunctionName As String*") Then
                     vbc.codemodule.InsertLines VarVBCLine + 1, "Dim VarFunctionName as String"
                     vbc.codemodule.InsertLines VarVBCLine + 2, "VarFunctionName = """ & Trim(Mid(vbc.codemodule.Lines(VarVBCLine, 1), InStr(1, vbc.codemodule.Lines(VarVBCLine, 1), "Function") + Len("Function"), Len(vbc.codemodule.Lines(VarVBCLine, 1)))) & """"
                    VarVBCLine = VarVBCLine + 3
            End If
        End If
         If UCase(vbc.codemodule.Lines(VarVBCLine, 1)) Like UCase("*End Function*") Then
            If Not (vbc.codemodule.Lines(VarVBCLine - 1, 1) Like "*Call FunctionReThrowError(Err, VarFunctionName)*") And Not (UCase(vbc.codemodule.Lines(VarVBCLine - 1, 1)) Like UCase("*Err.Raise*")) Then
                vbc.codemodule.InsertLines VarVBCLine, "ErrHandler:"
                vbc.codemodule.InsertLines VarVBCLine + 1, "Call FunctionReThrowError(Err, VarFunctionName)"
                VarVBCLine = VarVBCLine + 2
            End If
        End If
    Next VarVBCLine
   If Not (vbc.codemodule.Lines(1, 1) Like "*Function FunctionReThrowError(ByVal objError As ErrObject, PasFunctionName)*") Then
        vbc.codemodule.InsertLines 1, "Function FunctionReThrowError(ByVal objError As ErrObject, PasFunctionName)"
        vbc.codemodule.InsertLines 2, "Debug.Print PasFunctionName & objError.Description"
        vbc.codemodule.InsertLines 3, "Err.Raise objError.Number, objError.Source, objError.Description, objError.HelpFile, objError.HelpContext"
        vbc.codemodule.InsertLines 4, "End Function"
    End If
End Function

There are 2 problems with this code: It inserts the FunctionReThrowError function before Option declaration and if you run it the second time on the same module it messes up the code (after you added new Functions) — Vlado, Nov 12 '19 at 14:54

score 0 · Answer 10 · edited Jun 29 '19 at 11:48

Mark Ronollo's solution works like a charm.

I had the need to extract all procedure names from all modules for documentation purposes, so I took his code and adapted it into the function below, which detects all procedure names in all my code, including forms and modules, and then stores it into a table on my Access file called VBAProcedures (the table simply has a unique key, a column named [Module] and a column named [Procedure]. It saved me hours of manual work!

    Sub GetAllVBAProcedures()
    Dim Message As String, Query As String, tmpModule As String
    Dim MaxLines As Integer, tmpLine As Integer, i As Integer
    MaxLines = 4208
    Dim obj As AccessObject, db As Object
    Query = "delete from VBAProcedures"
    CurrentDb.Execute Query
    For i = 1 To Application.VBE.CodePanes.Count
        tmpModule = ""
        For tmpLine = 1 To MaxLines
            Message = Application.VBE.CodePanes(i).CodeModule.ProcOfLine(tmpLine, 0)
            If Message <> tmpModule And Message <> "" Then
                tmpModule = Message
                Query = "insert into VBAProcedures ([Module], [Procedure]) values ('" & Application.VBE.CodePanes(i).CodeModule.Name & "', '" & tmpModule & "')"
                CurrentDb.Execute Query
            End If
        Next tmpLine
    Next i
    End Sub

score 0 · Answer 11 · edited Oct 06 '20 at 00:16

We created a table named "Error Debug Log" that holds the error info, create a date field that the default field is Now() (to auto-polulate the date it happened) and another text field to hold the name of the Function.

Create a public function to add records when it fails:

Public Function DebugFunc(FuncName As String)
    FuncName = "INSERT INTO [Error Debug Log] ( FunctionName ) SELECT """ & (FuncName) & """"
    DoCmd.RunSQL ((FuncName))
End Function

Then Call it when the error happens, we find this to be easier so the info is in a table that we can examine later.

Call DebugFunc("name of your function or any other data")

If you are going to spend time assigning a value to variable with the name of the function, this is just easier to write the name whenever you need it.

score 0 · Answer 12 · answered Nov 23 '22 at 16:28

(Stack Overflow noob so please forgive any errors!)

I recently used Vlados code above which was very useful but I found some problems, so I have improved it a little. Here is my version:

Public Sub InsertErrHandling(modName As String)
    
    Dim Component As Object
    Dim Name As String
    Dim Kind As Long
    
    Dim lngFirstLine_Start As Long
    Dim lngFirstLine_End As Long
    Dim intFirstLine_Len As Integer
    
    Dim ProcLinesCount As Long
    Dim Declaration As String
    Dim ProcedureType As String
    Dim Index As Long
    Dim i As Long
    Dim j As Long
    Dim LastLine As Long
    Dim StartLines As Collection
    Dim LastLines As Collection
    Dim ProcNames As Collection
    Dim ProcedureTypes As Collection
    Dim gotoErr As Boolean
    
    Dim t As Integer
    Dim c As Integer
    Dim strTest As String
    Dim strModuleType As String
    
    'Kind = 0
    Kind = vbext_pk_Proc
    
    Set StartLines = New Collection
    Set LastLines = New Collection
    Set ProcNames = New Collection
    Set ProcedureTypes = New Collection

    Set Component = Application.VBE.ActiveVBProject.VBComponents(modName)               ' modName = form/module name
        With Component.CodeModule

            ' Remove empty lines on the end of the code
            For i = .CountOfLines To 1 Step -1
                If Component.CodeModule.Lines(i, 1) = "" Then
                  Component.CodeModule.DeleteLines i, 1
                Else
                    Exit For
                End If
            Next i

            Index = .CountOfDeclarationLines + 1
            Do While Index < .CountOfLines
                gotoErr = False                                                         ' Flag to indicate exising error handling
                Name = .ProcOfLine(Index, Kind)                                         ' Get proc name
                'FirstLine = .ProcBodyLine(Name, Kind)                                  ' Line number of first code line (declaration)  *Bad
                
                lngFirstLine_Start = .ProcBodyLine(Name, Kind)                          ' Line number of first code line (declaration)  *Bad
                lngFirstLine_End = lngFirstLine_Start
                intFirstLine_Len = 1
                
                ' Next line includes empty lines and comments!
                ProcLinesCount = .ProcCountLines(Name, Kind)                            ' Number of lines in procedure
                
                Declaration = Trim(.Lines(lngFirstLine_Start, 1))                                ' Get full proc declaration
                
                Do While Right(Declaration, 1) = "_"
                    ' This is a split declaration
                    lngFirstLine_End = lngFirstLine_Start + intFirstLine_Len
                    Declaration = Trim(.Lines(lngFirstLine_Start, intFirstLine_Len + 1))
                    intFirstLine_Len = intFirstLine_Len + 1
                Loop
                
                'This is incorrect
'                LastLine = lngFirstLine_Start + ProcLinesCount - 2                               ' Line number of last line  *Bad
                
                If InStr(1, Declaration, "Function ", vbBinaryCompare) > 0 Then         ' Get proc type
                    ProcedureType = "Function"
                Else
                    ProcedureType = "Sub"
                End If
                
                
                'Get correct last line
                strTest = ""
                LastLine = 0
                For t = lngFirstLine_Start To (lngFirstLine_Start + ProcLinesCount)
                    strTest = Trim(.Lines(t, 1))
                    If strTest Like "*End " & ProcedureType & "*" Then
                        LastLine = t
                        Exit For
                    End If
                Next t
                
                If LastLine = 0 Then
                    LastLine = lngFirstLine_Start + ProcLinesCount - 2
                End If
                
                
                'Show details
                Debug.Print Component.Name & "." & Name, "First: " & lngFirstLine_Start, "Lines:" & _
                            ProcLinesCount, "Last: " & LastLine, Declaration

                ' do not insert error handling if there is one already:
                For i = lngFirstLine_Start To LastLine Step 1
                    If Component.CodeModule.Lines(i, 1) Like "*On Error*" Then
                        gotoErr = True
                        Exit For
                    End If
                    If Component.Name = "modError" Then    ' Module that this code is in!
                        gotoErr = True
                        Exit For
                    End If
                Next i
                
                If Not gotoErr Then         ' If FALSE then add error trapping

                    StartLines.Add lngFirstLine_End
                    LastLines.Add LastLine
                    ProcNames.Add Name
                    ProcedureTypes.Add ProcedureType
                Else
                    Debug.Print Component.Name & "." & Name, "Existing Error handling"
                End If

                'Index = lngFirstLine_Start + ProcLinesCount + 1
                Index = LastLine + 1    '?
                
            Loop

            For i = LastLines.Count To 1 Step -1
                If Not (Component.CodeModule.Lines(StartLines.item(i) + 1, 1) Like "*On Error GoTo *") Then
                    If (Component.CodeModule.Lines(LastLines.item(i) - 1, 1)) Like "*End " & ProcedureTypes.item(i) Then
                        j = LastLines.item(i) - 1
                    Else
                        j = LastLines.item(i)
                    End If
                    
                    'Add lines to end of procedure
                    Component.CodeModule.InsertLines j, vbCrLf
                    Component.CodeModule.InsertLines j + 1, "ExitProc_:"
                    Component.CodeModule.InsertLines j + 2, "    DoCmd.Hourglass False"
                    
                    If Left(Component.Name, 8) = "Form_frm" Then
                        Component.CodeModule.InsertLines j + 3, "    <Company specific code here - Only for Forms>"
                    End If
                    
                    Component.CodeModule.InsertLines j + 4, "    Exit " & ProcedureTypes.item(i)
                    Component.CodeModule.InsertLines j + 5, vbCrLf
                    Component.CodeModule.InsertLines j + 6, "ErrHandler_:"
                    Component.CodeModule.InsertLines j + 7, "    DoCmd.Hourglass False"
                    Component.CodeModule.InsertLines j + 8, "    Call LogError(Err,  """ & modName & """, """ & ProcNames.item(i) & """)"
                    Component.CodeModule.InsertLines j + 9, "    Resume ExitProc_"
                    Component.CodeModule.InsertLines j + 10, "    Resume ' use for debugging"
                    
                    ' Add lines to start of procedure
                    Component.CodeModule.InsertLines StartLines.item(i) + 1, vbCrLf
                    Component.CodeModule.InsertLines StartLines.item(i) + 2, "    If blng_HandleErrors = True Then On Error GoTo ErrHandler_"
                    
                    
                    Debug.Print Component.Name & "." & ProcNames.item(i), "First: " & StartLines.item(i), "Last: " & j, "   Inserted"
                End If
            Next i
        End With
        
End Sub

The code I used previously had 2 main issues: It would get the last line of the procedure incorrectly (because when getting the first line it ignored white space and comments, but the function to get the procedure length includes white space and comments!), and secondly any procedure definition that had been split over several lines using underscores (due to it's length) was not detected. The code above corrects these problems, and also avoids changing the code that is running (in modError - I've had issues doing that in the past!). Hope this helps someone. — X_Mole, Nov 24 '22 at 09:00

Get Name of Current VBA Function

12 Answers12

Linked

Related