Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations gkittelson on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

procedures list

Status
Not open for further replies.

Sighn

MIS
Mar 29, 2006
4
US
Hello,

Is there a way to capture all procedures/functions names in a database. I use Msysobjects to capture tables, queries and reports.

Thanks
 
Sighn,

Here's a set of union queries that will work. I got parts of this from TekTips. It uses MSysObjects to identify different objects.

Code:
SELECT [%$##@_Alias].ObjTyp, MSysObjects.Name AS Expr1
FROM [SELECT MSysObjects.Name, "table" as ObjTyp  FROM MsysObjects WHERE (Left$([Name],1)<>"~") AND 
(Left$([Name],4) <> "Msys") AND (MSysObjects.Type)=1 

UNION 
 SELECT MSysObjects.Name , "query" as ObjTyp FROM MsysObjects WHERE (Left$([Name],1)<>"~") AND 
(MSysObjects.Type)=5 

UNION 
SELECT MSysObjects.Name, "form" as objTyp FROM MsysObjects WHERE (Left$([Name],1)<>"~") AND 
(MSysObjects.Type)=-32768 

UNION 
SELECT MSysObjects.Name, "report" as objtyp FROM MsysObjects WHERE (Left$([Name],1)<>"~") AND 
(MSysObjects.Type)= -32764 

UNION 
SELECT MSysObjects.Name,"module" as objtyp FROM MsysObjects WHERE (Left$([Name],1)<>"~") AND 
(MSysObjects.Type)= -32761 

UNION 
SELECT MSysObjects.Name, "macro" as objtyp FROM MsysObjects WHERE (Left$([Name],1)<>"~") AND 
(MSysObjects.Type)= -32766 

  
 ]. AS [%$##@_Alias]
GROUP BY [%$##@_Alias].ObjTyp, MSysObjects.Name
ORDER BY [%$##@_Alias].ObjTyp DESC;
 
Hello jedraw, Thanks for the immediate response. I used similar queries to find the above modules before. But I am really looking for event procedures and functions used behind the forms and reports.
 
Here are a few notes. A great deal comes from MS Help.
Code:
Sub ListProcs()
Dim i As Long
Dim modname As String
Dim mdl As Module
Dim strContent

For i = 0 To (Application.CurrentProject.AllModules.Count) - 1
    modname = Application.CurrentProject.AllModules(i).Name
    DoCmd.OpenModule modname
    Set mdl = Modules(modname)
    If mdl.CountOfLines > 0 Then
        strContent = mdl.Lines(1, mdl.CountOfLines)
        AllProcs (mdl.Name)
    End If
    Debug.Print modname & ": " & mdl.CountOfLines
    
    DoCmd.Close acModule, modname
    Set mdl = Nothing
Next i
End Sub

Sub ListClassProcs()
Dim frmname As String
Dim frmloop As AccessObject
Dim mdl As Module
Dim strContent

For Each frmloop In Application.CurrentProject.AllForms
    frmname = frmloop.Name
    DoCmd.OpenForm frmname, acDesign, , , , acHidden
    
    If Forms(frmname).HasModule Then
        Set mdl = Forms(frmname).Module
        If mdl.CountOfLines > 0 Then
            strContent = mdl.Lines(1, mdl.CountOfLines)
            AllProcs (mdl.Name)
        End If
        Debug.Print frmname & ": " & mdl.CountOfLines
    Else
        Debug.Print frmname & ":No Module"
    End If
    
    DoCmd.Close acForm, frmname

Next frmloop

Set mdl = Nothing

End Sub

Function AllProcs(strModuleName As String)
    Dim mdl As Module
    Dim lngCount As Long, lngCountDecl As Long, lngI As Long
    Dim strProcName As String, astrProcNames() As String
    Dim intI As Integer, strMsg As String
    Dim lngR As Long

    ' Open specified Module object.
    DoCmd.OpenModule strModuleName
    ' Return reference to Module object.
    Set mdl = 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
    ' Dialog box listing all procedures in module.
    'MsgBox strMsg
    Debug.Print strMsg
End Function
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top