' ----------------------------------------------------------------
' Procedure Name: ReportProcNames
' Purpose: Routine to write all procs and procedures to Table ModsAndProcsT
' Procedure Kind: Sub
' Procedure Access: Public
' Author: Jack
' Date: 26-Mar-23
' ----------------------------------------------------------------
Public Sub ReportProcNames()
Dim component As Object
Dim NameX As String
Dim Kind As Long
Dim Start As Long
Dim Body As Long
Dim Length As Long
Dim BodyLines As Long
Dim Declaration As String
Dim ProcedureType As String
Dim Index As Long
Dim ssql As String
10 On Error Resume Next
20 DoCmd.Hourglass True
30 CurrentDb.Execute "Drop Table ModsAndProcsT;", dbFailOnError ' rebuild the table
40 ssql = "Create Table ModsAndProcsT " _
& " (CompID AUTOINCREMENT Not Null Primary Key, ComponentName varchar(40), ProcName varchar(50),ProcType varchar(10), BodyLines Integer,runDate date);"
50 CurrentDb.Execute ssql, dbFailOnError
60 Debug.Print "Component/Module Name" & String(20, " ") & "Proc Name" & _
String(30, " ") & "ProcedureType" & " " & "NumBodyLines" & vbCrLf _
& String(110, "-") & vbCrLf
70 For Each component In Application.VBE.ActiveVBProject.VBComponents
80 With component.CodeModule
'The Procedures
90 Index = .CountOfDeclarationLines + 1
100 Do While Index < .CountOfLines
110 NameX = .ProcOfLine(Index, Kind)
120 Start = .ProcStartLine(NameX, Kind)
130 Body = .ProcBodyLine(NameX, Kind)
140 Length = .ProcCountLines(NameX, Kind)
150 BodyLines = Length - (Body - Start)
160 Declaration = Trim(.Lines(Body, 1))
170 ProcedureType = GetProcKind(Kind, Declaration)
180 Call WriteToModsAndProcsT(component.name, NameX, ProcedureType, BodyLines, Date)
190 Debug.Print component.name & String(55 - Len(component.name), " ") & NameX & " " & _
String(45 - Len(NameX), " ") & ProcedureType & String(20 - Len(ProcedureType), " ") & CStr(BodyLines)
200 Index = Start + Length + 1
210 Loop
220 End With
230 Debug.Print
240 Next component
250 If Not component Is Nothing Then Set component = Nothing
260 Debug.Print "Finished reporting Procs and Modules"
270 DoCmd.Hourglass False
End Sub
Public Function GetProcKind(Kind As Long, Declaration As String) As String
'Change the procedure kind to text
Select Case Kind
Case vbext_pk_Get
GetProcKind = "Get"
Case vbext_pk_Let
GetProcKind = "Let"
Case vbext_pk_Set
GetProcKind = "Set"
'Best Guess
Case vbext_pk_Proc
If InStr(1, Declaration, "Function ", vbBinaryCompare) > 0 Then
GetProcKind = "Func"
Else
GetProcKind = "Sub"
End If
Case Else
GetProcKind = "Undefined"
End Select
End Function
' ----------------------------------------------------------------
' Procedure Name: WriteToModsAndProcsT
' Purpose: Routine to write to ModsAndProcsT
' Procedure Kind: Sub
' Procedure Access: Public
' Author: Jack
' Date: 24-Mar-23
' ----------------------------------------------------------------
Sub WriteToModsAndProcsT(ComponentName, ProcName, ProcType, BodyLines, rundate)
Const InsSQL As String = _
"Insert into ModsAndProcsT (ComponentName,ProcName,ProcType, BodyLines, rundate)" _
& " VALUES ( p0,p1,p2,p3,p4)"
With CurrentDb.CreateQueryDef("", InsSQL)
.Parameters("p0") = ComponentName
.Parameters("p1") = ProcName
.Parameters("p2") = ProcType
.Parameters("p3") = BodyLines
.Parameters("p4") = Date
.Execute dbFailOnError
End With
End Sub