Question

对于错误处理代码，我想获得发生错误的当前VBA函数（或sub）的名称。有谁知道如何做到这一点？

[编辑]感谢所有人，我曾希望存在一个无证的技巧来自我决定这个功能，但这显然不存在。猜猜我会继续使用我目前的代码：

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

Answer 1

没有什么可以获得当前的函数名称，但您可以使用VBA对象生存期是确定性的这一事实构建一个相当轻量级的跟踪系统。例如，您可以使用以下代码创建名为“Tracer”的类：

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

然后在例程中使用该类：

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

如果你运行'sub1'，你应该得到这个输出：

unhandled error in sub2
handled error

因为当错误导致例程退出时，'sub2'中的Tracer实例被确定性地销毁了。

这种一般模式在C ++中以“RAII”的名称出现很多，但它在VBA中也可以正常工作（除了使用类的一般烦恼之外）。

编辑：

为了解决David Fenton的评论，即对于一个简单的问题，这是一个相对复杂的解决方案，我认为问题实际上并不那么简单！

我认为我们都同意我们不希望在VBA程序中为每个例程提供自己的错误处理程序。（参见我的推理：VBA Error "Bubble Up"）

如果某些内部例程没有自己的错误处理程序，那么当我们做捕获错误时，我们所知道的就是在例程中发生了错误处理程序触发或在例程在调用堆栈的更深处。所以我理解的问题实际上是跟踪我们程序的执行之一。当然，追踪例行录入很容易。但追踪退出确实非常复杂。例如，可能会出现错误！

RAII方法允许我们使用VBA对象生命管理的自然行为来识别我们何时退出例程，无论是通过“退出”，“结束”还是错误。我的玩具示例只是为了说明这个概念。我自己的小VBA框架中真正的“跟踪器”当然更复杂，但也做得更多：

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

但使用它仍然非常简单，无论如何都比“每个例程中的EH”方法更少：

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

...

自动生成样板文件很简单，虽然我实际输入并自动检查以确保例程/ arg名称与我的测试一致。

Answer 2

我在免费MZTools for VBA.中使用错误处理程序按钮它会自动添加代码行以及子/函数名称。现在，如果重命名子/函数，则必须记住更改代码。

MZTools内置了许多不错的功能。比如改进的查找屏幕，最重要的是一个按钮，显示调用此子/函数的所有位置。

Answer 3

不使用任何内置的VBA方式。你能做的最好的事情是通过将方法名称硬编码为常量或常规方法级变量来重复自己。

Const METHOD_NAME = "GetCustomer"

 On Error Goto ErrHandler:
 ' Code

ErrHandler:
   MsgBox "Err in " & METHOD_NAME

您可以在MZ Tools for VBA中找到方便的内容。它是VB系列语言的开发人员加载项。由MVP撰写。

Answer 4

VBA没有可以以编程方式访问的任何内置堆栈跟踪。你必须设计自己的堆栈并按下/弹出它来完成类似的事情。否则，您需要将您的函数/子名称硬编码到代码中。

Answer 5

vbWatchdog 是该问题的商业解决方案。它的功能价格非常合理。除其他功能外，它还提供对VBA调用堆栈的完全访问权限。我知道没有其他产品可以做到这一点（我看过）。

还有其他一些功能，包括变量检查和自定义错误对话框，但单独访问堆栈跟踪值得承认。

注意：除了我是一个非常满意的用户之外，我与产品无关。

Answer 6

肖恩·亨德里克斯的代码一点也不差劲。我做了一点改进：

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

您可以将其放在单独的模块中，并按以下方式调用它：

AddErrorCode "Form_MyForm"

在立即窗口中。它将更改您的表单代码：

Private Sub Command1_Click()

    Call DoIt

End Sub

在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

您可以为同一表单重复运行它，并且不会重复代码。您需要创建一个公共子程序来捕获错误，并将代码写入文件或数据库以进行记录。

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

Answer 7

这对我有用。我在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

Answer 8

代码很难看但它有效。此示例将向每个函数添加错误处理代码，该函数还包含具有函数名称的字符串。

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

Answer 9

马克·罗诺（Mark Ronollo）的解决方案像灵符。

出于文档目的，我需要从 all 模块中提取 all 过程名称，因此我采用了他的代码并将其改编为下面的函数，该函数可以检测所有过程在我的所有代码（包括表单和模块）中命名，然后将其存储到我的Access文件中名为VBAProcedures的表中（该表仅具有唯一键，名为[Module]的列和名为{ {1}}，这为我节省了很多时间！

[Procedure]

Answer 10

我们创建了一个名为"Error Debug Log"的表，该表包含错误信息，创建一个日期字段，其默认字段为Now()（以自动生成发生日期），另一个文本字段用于保存错误信息。函数的名称。

创建一个公共函数以在失败时添加记录：

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

然后Call发生错误时，我们发现它更容易，因此该信息位于一个表中，我们可以稍后对其进行检查。

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

如果您要花费时间为带有函数名称的变量赋值，那么在需要时就更容易写出名称。

Answer 11

真的？为什么开发人员会一遍又一遍地解决同样的问题？发送使用Err.Raise ...

将过程名称输入到Err对象中

对于Source参数传入：

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

我知道这不是最短的一个班轮，但如果你买不起商业产品来增强VBA IDE，或者像我们许多人一样，只能在一个锁定的环境中工作，那么这是最简单的解决方案。

获取当前VBA功能的名称

11 个答案: