Averiguar si existe un procedimiento

[xavi]

Palabras clave: Averiguar, saber, existe, procedimiento, código
Autor: Xavi
Objetivo:
A veces, durante la vida de una aplicación, es necesario lanzar procedimientos con nombres de funciones que pueden no existir en nuestra aplicación. Para averiguar si existen, tengo un pequeño módulo que me ayuda

Código: [Seleccionar]

' ****************************************************************************
' Versión:                      1.000
' Fecha última modificación:    02/09/2019
' Propósito:                    Averiguar si existe módulo y/o procedimiento
' ****************************************************************************
' Ver final del módulo para historial de versiones
' ****************************************************************************


Function ExisteModulo(strModule As String) As Boolean
    On Error GoTo ErrorHandler
   
    Dim mdl As AccessObject
   
    For Each mdl In CurrentProject.AllModules
        If mdl.Name = strModule Then
            ExisteModulo = True
            Exit Function
        End If
    Next
               
    ExisteModulo = False

ExitProcedure:
    On Error GoTo 0
    Exit Function
ErrorHandler:
    Select Case Err.Number
        Case 0
        Case Else
            MsgBox "Error " & Err.Number & "-" & Err.Description
            Resume ExitProcedure
    End Select
End Function

Function ExisteProcedimiento(strModule As String, strProcedureName As String) As Boolean
    On Error GoTo ErrorHandler
   
    Dim mdl         As Module
    Dim lngSLine    As Long
    Dim lngSCol     As Long
    Dim lngELine    As Long
    Dim lngECol     As Long
    Dim strLine     As String
    Dim strNewLine  As String
    Dim intChr      As Integer
    Dim intBefore   As Integer
    Dim intAfter    As Integer
    Dim strLeft     As String
    Dim strRight    As String

    If ExisteModulo(strModule) Then
        Set mdl = Modules(strModule)
    Else
        ExisteProcedimiento = False
    End If
   
    If mdl.Find(strProcedureName, lngSLine, lngSCol, lngELine, lngECol) Then
        ExisteProcedimiento = True
    Else
        ExisteProcedimiento = False
    End If
    Set mdl = Nothing

ExitProcedure:
    On Error GoTo 0
    Exit Function
ErrorHandler:
    Select Case Err.Number
        Case 0
        Case 7961
            ' No parece que podamos acceder a él
            DoCmd.OpenModule strModule
            Resume
        Case Else
            MsgBox "Error " & Err.Number & "-" & Err.Description
            Resume ExitProcedure
    End Select
End Function

' *****************  HISTORIAL ********************  HISTORIAL ********************  HISTORIAL ********************  HISTORIAL ********************
'   Fecha       Versión Procedimiento           Descripción
'   ----------  ------- ----------------------- --------------------------------------------------------------------------------------------------
'   02/09/2019  1.001                           Primera versión documentada



[xavi]

Como siempre, sólo hay que bucear un poco para encontrar una respuesta que mejore ampliamente el rendimiento. Y, como no, la respuesta es de Happy. Utilizando el objeto indocumentado WizHook.

Código: [Seleccionar]

Function whExisteProcedimiento(strProcedure As String) As Boolean
    WizHook.Key = 51488399
    whExisteProcedimiento = WizHook.GlobalProcExists(strProcedure)
End Function