Get Stats About VBA Project (1 Viewer)

Status
Not open for further replies.

George Moore

Access 2002,2010 & 2016
Local time
Today, 03:10
Joined
Aug 29, 2013
Messages
44
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.

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
 

isladogs

MVP / VIP
Local time
Today, 10:10
Joined
Jan 14, 2017
Messages
18,186
The function created by George worked well for me on a small database with no backend tables taking less than 5 seconds to complete

However, when tested on a very large split database, it was terribly slow taking over 18 minutes to complete. See detailed comments on this thread:
https://www.access-programmers.co.uk/forums/showthread.php?t=296853

I decided to make my own version which has additional information and more importantly ran far faster on my test databases. Times for the above databases were reduced to about 1 second and 1 minute respectively

The output is sent to the immediate window :



It is also displayed as a message box:



The message box layout isn't as neat as I'd like. However, I've spent too long on this today to do any more.

At some point in the future, I may add provision to save the data to a log text file as a further option

You will need to copy all the following items to your own databases.
- Table - tblSysObjectTypes
- Queries - qryDatabaseObjects, qryDatabaseObjectCount & (optionally) qryDatabaseObjectSummary
- Modules modDatabaseStatistics & modVBECode

You will also need to add the VBA reference: Microsoft Visual Basic for Applications Extensibility 5.3
 

Attachments

  • DatabaseStats.accdb
    672 KB · Views: 675
  • DatabaseStats1.jpg
    DatabaseStats1.jpg
    81.8 KB · Views: 2,091
  • DatabaseStat2.PNG
    DatabaseStat2.PNG
    16.2 KB · Views: 1,955
Last edited:

isladogs

MVP / VIP
Local time
Today, 10:10
Joined
Jan 14, 2017
Messages
18,186
Belatedly discovered that if you have the MZ Tools add in, it contains its own statistics feature which is very fast.



The output can be exported to a text file or Excel.
 

Attachments

  • CaptureMZ.PNG
    CaptureMZ.PNG
    26 KB · Views: 1,370
Status
Not open for further replies.

Users who are viewing this thread

Top Bottom