Получить имя текущей функции VBA

Для кода обработки ошибок я хотел бы получить имя текущей функции (или вспомогательной) VBA, в которой произошла ошибка. Кто-нибудь знает, как это можно сделать?

[EDIT] Спасибо, я надеялся, что существует недокументированный трюк, чтобы самостоятельно определить функцию, но этого, очевидно, не существует. Думаю, я останусь с моим текущим кодом:

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

Ответ 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

потому что ваш экземпляр Tracer в 'sub2' был детерминированно уничтожен, когда ошибка вызвала выход из этой процедуры.

Этот общий шаблон часто встречается на С++ под именем "RAII", но он отлично работает и в VBA (кроме общего раздражения использования классов).

EDIT:

Чтобы обратиться к Дэвиду Фентону, прокомментируйте, что это относительно сложное решение простой проблемы, я не думаю, что проблема на самом деле такая простая!

Я считаю само собой разумеющимся, что все мы согласны с тем, что мы не хотим давать каждой программе в нашей программе VBA собственный обработчик ошибок. (См. Мои рассуждения здесь: Ошибка VBA "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 совпадают как часть моих тестов.

Ответ 2

Я использую кнопку обработчика ошибок в свободном MZTools для VBA. Он автоматически добавляет строки кода вместе с именем sub/function. Теперь, если вы переименуете функцию sub/, которую вы должны запомнить, чтобы изменить код.

У MZTools много встроенных функций. Например, улучшенный экран поиска и, самое главное, кнопка, показывающая вам все места, где вызывается эта функция sub/.

Ответ 3

Не использовать встроенный способ VBA. Лучшее, что вы сможете сделать, - это повторить себя путем жесткого кодирования имени метода как постоянной или регулярной переменной уровня метода.

Const METHOD_NAME = "GetCustomer"

 On Error Goto ErrHandler:
 ' Code

ErrHandler:
   MsgBox "Err in " & METHOD_NAME

Вы можете найти что-то удобное в MZ Tools for VBA. Это надстройка разработчика для семейств VB. Написано MVP.

Ответ 4

У VBA нет встроенной трассировки стека, к которой вы можете обращаться программно. Вам нужно будет создать свой собственный стек и нажать на него, чтобы выполнить что-то подобное. В противном случае вам нужно будет жестко закодировать свои имена функций/подписок в коде.

Ответ 5

vbWatchdog - это коммерческое решение проблемы. Он очень разумно оценен по своим возможностям. Среди других функций он предлагает полный доступ к стеклу вызовов VBA. Я не знаю другого продукта, который делает это (и я посмотрел).

Есть несколько других функций, включая диалоговые окна проверки переменных и настраиваемых ошибок, но доступ к трассировке стека стоит того, чтобы цена была допущена.

ПРИМЕЧАНИЕ. Я никоим образом не связан с продуктом, кроме того, что я очень довольный пользователь.

Ответ 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

Ответ 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

Ответ 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

Ответ 9

Решение Mark Ronollo работает как шарм.

Мне нужно было извлечь все имена процедур из всех модулей для целей документирования, поэтому я взял его код и адаптировал его к функции ниже, которая обнаруживает все имена процедур во всем моем коде, включая формы и модули, а затем сохраняет его в таблица в моем файле Access с именем VBAProcedures (таблица просто имеет уникальный ключ, столбец с именем [Module] и столбец с именем [Procedure]. Это сэкономило мне часы ручной работы!

    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

Ответ 10

Серьезно? Почему разработчики продолжают решать одну и ту же проблему снова и снова? Отправить получить имя процедуры в объект Err, используя Err.Raise...

Для параметра Source pass in:

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

Я знаю, что это не самый короткий слот, но если вы не можете позволить себе коммерческий продукт для улучшения VBA IDE или если, как и многие из нас, ограничены работой в закрытой среде, тогда это самое простое решение.