如何在运行时获取过程或函数名称？

Question

有没有办法在运行时返回函数或过程的名称？

我目前正在处理这样的错误:

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

在我更新函数名称后,我最近经历了一个向我说谎的常量,但不是常量值.我想将过程的名称返回给我的错误处理程序.

我知道我必须与VBIDE.CodeModule对象进行交互才能找到它.我已经使用Microsoft Visual Basic for Applications Extensibility库进行了一些元编程,但是我在运行时没有取得任何成功.我没有以前的尝试,在我再次尝试这个尝试之前,我想知道它是否可以远程实现.

事情是行不通的

1. 使用一些内置的VBA库来访问调用堆栈.它不存在.
2. 当我进入并退出每个程序名时,通过从数组中推送和弹出程序名来实现我自己的调用堆栈.这仍然要求我将proc名称作为字符串传递给其他地方.
3. 像vbWatchDog这样的第三方工具.这确实有效,但我不能在这个项目中使用第三方工具.

注意

vbWatchdog似乎是通过API调用直接访问内核内存来实现的.

Answer 1

我不太确定这会有多大帮助......

好处是您不必担心子/函数名称 - 您可以自由更改它.您需要关心的是错误处理程序标签名称的唯一性.

例如

如果可以避免在不同的子/函数中重复的错误处理程序标签

不要做⇩⇩⇩⇩⇩

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

然后下面的代码应该工作.

注意:我无法彻底测试它,但我相信你可以调整它并让它工作,如果有任何帮助.

注意:Visual Basic for Applications Extensibility 5.3在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

Answer 2

我使用一个基于链接节点的堆栈类，该类封装在一个单例、全局实例化（通过属性完成）CallStack类中。它允许我像 David Zemens 建议的那样执行错误处理（每次保存过程名称）：

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

如果对讨论有帮助，我可以发布相关代码。CallStack 类有一个Peek方法可以找出最近调用的函数是什么，还有一个StackTrace函数可以获取整个堆栈的字符串输出。

更具体地说，我一直对使用 VBA 扩展性自动添加样板错误处理代码（如上）感兴趣。我从来没有真正做到过，但我相信这是很有可能的。