George Moore
Access 2002,2010 & 2016
- Local time
- Today, 04:22
- Joined
- Aug 29, 2013
- Messages
- 38
Hi
This is something I wrote for my own curiosity because I wanted to know how many lines of code were in a project but it may be useful to other developers.
It is a fairly simple sub which seqentially examines all tables, forms, reports and modules in a project and produces stats about number of fields, controls, VBA functions, lines of code etc.
It is only intended to be used on design masters not ACCDE files.
As all forms are opened, scrutinised and closed, you will need to close & re-open the database or run an autoexec macro to return to a dashboard when it has completed.
This is something I wrote for my own curiosity because I wanted to know how many lines of code were in a project but it may be useful to other developers.
It is a fairly simple sub which seqentially examines all tables, forms, reports and modules in a project and produces stats about number of fields, controls, VBA functions, lines of code etc.
It is only intended to be used on design masters not ACCDE files.
As all forms are opened, scrutinised and closed, you will need to close & re-open the database or run an autoexec macro to return to a dashboard when it has completed.
Code:
Sub ProduceStats()
Rem*******************************************
Rem 2017.04.04.04 Set Up
Rem*******************************************
Dim s1 As String
Dim v1 As Variant
On Error GoTo oops
Rem*******************************************
Rem 2017.04.04.04 Table Stats
Rem*******************************************
Dim NoOfTables As Long, NoOfFields As Long, NoOfRecords As Long
For Each v1 In CurrentDb.TableDefs
NoOfTables = NoOfTables + 1
NoOfFields = NoOfFields + v1.Fields.Count
NoOfRecords = NoOfRecords + DCount("*", v1.Name)
Next v1
Rem*******************************************
Rem 2017.04.04.04 Form Stats
Rem*******************************************
Dim NoOfForms As Long, NoOfControls As Long, NoOfModules As Long, NoOfFunctions As Long, CodeLines As Long, LineNumber As Long
For v1 = 0 To CurrentDb.Containers("Forms").Documents.Count - 1
s1 = CurrentDb.Containers("Forms").Documents(v1).Name
NoOfForms = NoOfForms + 1
DoCmd.OpenForm s1, acDesign, , , , acHidden
NoOfControls = NoOfControls + Forms(s1).Controls.Count
If Forms(s1).HasModule = True Then
NoOfModules = NoOfModules + 1
CodeLines = CodeLines + Forms(s1).Module.CountOfLines
For LineNumber = 1 To Forms(s1).Module.CountOfLines
If Trim(UCase(Forms(s1).Module.Lines(LineNumber, 1))) Like "FUNCTION *" _
Or Trim(UCase(Forms(s1).Module.Lines(LineNumber, 1))) Like "SUB *" _
Or Trim(UCase(Forms(s1).Module.Lines(LineNumber, 1))) Like "PRIVATE FUNCTION *" _
Or Trim(UCase(Forms(s1).Module.Lines(LineNumber, 1))) Like "PRIVATE SUB * " Then
NoOfFunctions = NoOfFunctions + 1
End If
Next LineNumber
End If
DoCmd.Close acForm, s1, acSaveYes
Next v1
Rem*******************************************
Rem 2017.04.04.04 Reports
Rem*******************************************
Dim NoOfReports As Long
For v1 = 0 To CurrentDb.Containers("Reports").Documents.Count - 1
s1 = CurrentDb.Containers("Reports").Documents(v1).Name
NoOfReports = NoOfReports + 1
DoCmd.OpenReport s1, acDesign, , , , acHidden
NoOfControls = NoOfControls + Reports(s1).Controls.Count
If Reports(s1).HasModule = True Then
CodeLines = CodeLines + Reports(s1).Module.CountOfLines
For LineNumber = 1 To Reports(s1).Module.CountOfLines
If Trim(UCase(Reports(s1).Module.Lines(LineNumber, 1))) Like "FUNCTION *" _
Or Trim(UCase(Reports(s1).Module.Lines(LineNumber, 1))) Like "SUB *" _
Or Trim(UCase(Reports(s1).Module.Lines(LineNumber, 1))) Like "PRIVATE FUNCTION *" _
Or Trim(UCase(Reports(s1).Module.Lines(LineNumber, 1))) Like "PRIVATE SUB * " Then
NoOfFunctions = NoOfFunctions + 1
End If
Next LineNumber
End If
DoCmd.Close acReport, s1, acSaveYes
Next v1
Rem*******************************************
Rem 2017.04.04.04 Modules
Rem*******************************************
For v1 = 0 To CurrentProject.AllModules.Count - 1
s1 = CurrentProject.AllModules(v1).Name
DoCmd.OpenModule s1
CodeLines = CodeLines + Modules(s1).CountOfLines
For LineNumber = 1 To Modules(s1).CountOfLines
If Trim(UCase(Modules(s1).Lines(LineNumber, 1))) Like "FUNCTION *" _
Or Trim(UCase(Modules(s1).Lines(LineNumber, 1))) Like "SUB * " Then
NoOfFunctions = NoOfFunctions + 1
End If
Next LineNumber
On Error Resume Next
DoCmd.Close acModule, s1, acSaveYes
On Error GoTo oops
Next v1
Rem*******************************************
Rem 2017.04.04.04 Compile Message
Rem*******************************************
s1 = "Tables : = " & NoOfTables & vbNewLine
s1 = s1 & "Fields : = " & NoOfFields & vbNewLine
s1 = s1 & "Records : = " & NoOfRecords & vbNewLine
s1 = s1 & "Forms : = " & NoOfForms & vbNewLine
s1 = s1 & "Reports : = " & NoOfReports & vbNewLine
s1 = s1 & "Controls : = " & NoOfControls & vbNewLine
s1 = s1 & "Functions : = " & NoOfFunctions & vbNewLine
s1 = s1 & "Lines Of Code := " & CodeLines
MsgBox s1
Rem*******************************************
Rem 2017.04.04.04 Compile Message
Rem*******************************************
Exit Sub
oops:
MsgBox Error$
End Sub
