QUESTION: Get All Procedure Names from Modules | Access World Forums


Tue Feb 15 2022 12:30:28 GMT+0000 (Coordinated Universal Time)

Saved by @paulbarry #vba

Public Function AllProcs(ByVal strDatabasePath As String, ByVal strModuleName As String)
    Dim appAccess As Access.Application
    Dim db As Database
    Dim mdl As Module
    Dim lngCount As Long
    Dim lngCountDecl As Long
    Dim lngI As Long
    Dim strProcName As String
    Dim astrProcNames() As String
    Dim intI As Integer
    Dim strMsg As String
    Dim lngR As Long

    Set appAccess = New Access.Application

    appAccess.OpenCurrentDatabase strDatabasePath
    ' Open specified Module object.
    appAccess.DoCmd.OpenModule strModuleName
    ' Return reference to Module object.
    Set mdl = appAccess.Modules(strModuleName)
    ' Count lines in module.
    lngCount = mdl.CountOfLines
    ' Count lines in Declaration section in module.
    lngCountDecl = mdl.CountOfDeclarationLines
    ' Determine name of first procedure.
    strProcName = mdl.ProcOfLine(lngCountDecl + 1, lngR)
    ' Initialize counter variable.
    intI = 0        ' Redimension array.
    ReDim Preserve astrProcNames(intI)
    ' Store name of first procedure in array.
    astrProcNames(intI) = strProcName
    ' Determine procedure name for each line after declarations.
    For lngI = lngCountDecl + 1 To lngCount
        ' Compare procedure name with ProcOfLine property value.
        If strProcName <> mdl.ProcOfLine(lngI, lngR) Then
            ' Increment counter.
            intI = intI + 1
            strProcName = mdl.ProcOfLine(lngI, lngR)
            ReDim Preserve astrProcNames(intI)
            ' Assign unique procedure names to array.
            astrProcNames(intI) = strProcName
        End If
    Next lngI
    strMsg = "Procedures in module '" & strModuleName & "': " & vbCrLf & vbCrLf
    For intI = 0 To UBound(astrProcNames)
        strMsg = strMsg & astrProcNames(intI) & vbCrLf
    Next intI
    ' Message box listing all procedures in module.
    Debug.Print strMsg
    Set appAccess = Nothing
End Function