Statistics about the code

B

benjamin.weizmann

Registered User.
Local time
Today, 15:14
Joined
Aug 30, 2016
Messages
78
hi :)
is there any way to achieve statistic about the vba con in vba editor
like how much functions, how much code rows etc..

thanks
Ben
 
Dim i As Integer
Debug.Print Modules.Count
For i = 0 To Modules.Count - 1
Debug.Print Modules.item(i).CountOfLines
Next
 
Hi

This will give tell you anything you ever wanted to know about your VBA project

In addition to modules, this will count code hidden behind forms and reports.

You will need to close/open your database after it has run as it opens and closes all forms, reports etc etc.


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
     Dim 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 finished
Rem*******************************************
    

    Exit Sub
    
oops:
    MsgBox Error$

End Sub
 
Thats good but you cant use the form/report part on accde or accdr.
 
George Moore said:
Hi

This will give tell you anything you ever wanted to know about your VBA project

In addition to modules, this will count code hidden behind forms and reports.

You will need to close/open your database after it has run as it opens and closes all forms, reports etc etc.


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
     Dim 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 finished
Rem*******************************************
    

    Exit Sub
    
oops:
    MsgBox Error$

End Sub
Click to expand...

wow wow wow
amazing
say me please does it count also this sub?

Ben
 
Hi

Arnel is correct, this is only for use on design masters not ACCDE files issued to users and "yes", it should count itself in the stats as it saved in a module

Count of code lines is somewhat subjective as there will be rem & blank lines which I haven't bothered to exclude
 
Hi

Thanks - Its a nice bit of code and runs quickly.
Looks like it lists everything except macros but that's not an issue for me.
Suggest you add this to the code repository so its easier for others to find.

Just added a few bits of info to the code to get this output on the db I'm working on:

attachment.php


I also tried running it on my largest production FE database for interest.
It's a 140MB monster with almost 20,000 objects.
Unfortunately, it just hangs - may need to increase file locks in registry?
Will look into the reasons later

Instead of a msg box, you could of course use Debug.Print to list in the immediate window.
I'm also going to tweak it so it adds the stats to a log file.

All the VBE windows closed nicely for me but if you do need to close any windows left open after using it, just run this function:

Code: 
Function CloseAllVBEWindows() 

'closes all VBE windows except the one containing this function!

'02/02/2016 - added error handling to fix issue in 64-bit Office
'08/03/2017 - changed to late binding to remove need for VBE Extensibility reference

On Error GoTo Err_Handler

'Dim vbWin As VBIDE.Window 'removed 08/03/2017
Dim vbWin As Object 'added 08/03/2017
Const vbext_wt_CodeWindow = 0
Const vbext_wt_Designer = 1

For Each vbWin In Application.VBE.Windows
     If (vbWin.Type = vbext_wt_CodeWindow Or _
         vbWin.Type = vbext_wt_Designer) And _
         Not vbWin Is Application.VBE.ActiveWindow Then
             vbWin.Close
     End If
 Next
 
Exit_Handler:
    Exit Function

Err_Handler:
    If Err.Number = 424 Then Resume Next 'object required
    MsgBox "Error " & Err.Number & " in CloseAllVBEWindows procedure: " & Err.Description
    Resume Exit_Handler

End Function
 

Attachments

  • Capture.PNG
    Capture.PNG
    11.1 KB · Views: 556
Nice procedure. I agree with Colin, should be in the code repository.

I had a table that was not on this computer and identified it with error 3044 -
added some code to print a message and resume.

Here are stats from my test/sample database.

Code: 
This table qselProductSalesCalculator  is referencing a folder that is not on this computer
Tables : = 634
Fields : = 2670
Records : = 462106
Forms : = 149
Reports : = 15
Controls : = 1227
Functions : = 231
Lines Of Code := 46244
 
Last edited:
I have added it to the code repository, it will viewable after it has been moderated

Quite happy for anyone to adapt, enhance and repost it to the repository

My code count is current 284 functions and 131,761 lines of code
 
Thanks for doing that
Just realised your code doesn't count queries - easy enough to add them ...

I tried my monster database again using your code & left it running
Almost 18 minutes later, I got:

attachment.php


Great but a bit too slow for this db .... :D

So I've been working on a similar version using MSysObjects where possible. For the same database this is the output I have so far in the immediate window....

attachment.php


Much faster .... 'only' 70 seconds!

I just need to add the code to count the controls & I'll also upload my version
 

Attachments

  • CaptureSDA.PNG
    CaptureSDA.PNG
    11.1 KB · Views: 551
  • CaptureSDA NEW.PNG
    CaptureSDA NEW.PNG
    12.8 KB · Views: 542
Hi Ridders

Suggest you upload your version as it is a clear enhancement which will satisfy the curiosity of many a developer.

I wrote the original purely because I wanted some facts for a Powerpoint presentation
 
Why the discrepancy in tables Colin?
Yours has two less tables, but more fields and records?

ridders said:
Thanks for doing that
Just realised your code doesn't count queries - easy enough to add them ...

I tried my monster database again using your code & left it running
Almost 18 minutes later, I got:

attachment.php


Great but a bit too slow for this db .... :D

So I've been working on a similar version using MSysObjects where possible. For the same database this is the output I have so far in the immediate window....

attachment.php


Much faster .... 'only' 70 seconds!

I just need to add the code to count the controls & I'll also upload my version
Click to expand...
 
I gave George kudos, but there is an error in counting Functions in the Form stat section. To get the actual count of Subs & Functions something like this should be used instead of what George presented. His code omits Public subs and functions:

Code: 
If Trim(UCase(Forms(s1).Module.Lines(LineNumber, 1))) = "END FUNCTION" _
Or Trim(UCase(Forms(s1).Module.Lines(LineNumber, 1))) = "END SUB" Then

Best,
Jiri
 
I also spotted that and changed it to:

Code: 
If Trim(UCase(Forms(s1).Module.Lines(LineNumber, 1))) Like "*FUNCTION *" _
                Or Trim(UCase(Forms(s1).Module.Lines(LineNumber, 1))) Like "*SUB*" Then
 
Code:
Hi Gasman

Why the discrepancy in tables Colin?
Yours has two less tables, but more fields and records?
Click to expand...

Hi
Well spotted ... I hadn't noticed that

Not that this answers your question BUT:
My totals for tables etc are from MSysObjects rather than George's code

However the fields and records totals are using the same code as George so that's odd

Will look into it further
Just trying to writing code to count all procedures without opening them.
That should prevent screen flicker & also speed it up further
Otherwise mine is now done

Test database output (not the big one):

Code: 
Database summary : JSONParser.accdb
================================================================
Path : C:\Programs\MendipDataSystems\JSONParser\JSONParser.accdb
File size = 28800 KB   (28.1 MB)
Analysis completed on : 09/11/2017 18:24:44

Tables :                    136
Fields :                    920
Records :                   15845

Queries :                   30

Forms :                     19
Form Controls :             451
Form Modules :              18

Reports :                   6
Report Controls :           190
Report Modules :            5

Macros :                    2
Modules (Standard/Class) :  26
Module Procedures :         1651
Total Code Lines :          27940

Relationships :             49

Time taken :                9 seconds
 
I've now finished my version of the database statistics function and I'm pleased to say it runs much faster on both databases I've tested.
I'll upload it tomorrow but first I have a question.

Here is the output for 2 test databases

1. Smallish unsplit database (1 second)

Code: 
Database summary : JSONParser.accdb
================================================================
Path : C:\Programs\MendipDataSystems\JSONParser\JSONParser.accdb
File size = 20992 KB   (20.5 MB)
Analysis completed on : 09/11/2017 23:28:46

Tables :                    136
Fields :                    920
Records :                   15956

Queries :                   30

Forms :                     19
Form Controls :             451
Form Modules :              18

Reports :                   6
Report Controls :           190
Report Modules :            5

Macros :                    2

Modules (Standard/Class) :  27
Module Procedures :         606
Total Code Lines :          28103

Relationships :             49

Time taken :                1 seconds
================================================================


2. For my 'monster' database it took much longer (270 s)

Code: 
Database summary : SDA.accdb
==================================================
Path : C:\Programs\MendipDataSystems\SDA\SDA.accdb
File size = 135360 KB   (132.2 MB)
Analysis completed on : 09/11/2017 22:53:01

Tables :                    329
Fields :                    4391
Records :                   4581764

Queries :                   1579

Forms :                     569
Form Controls :             19428
Form Modules :              1431

Reports :                   874
Report Controls :           30671
Report Modules :            823

Macros :                    14

Modules (Standard/Class) :  106
Module Procedures :         12531
Total Code Lines :          395870

Relationships :             1

Time taken :                270 seconds
==================================================

However I noticed something very odd when it calculated total record count.

Both versions of the code below SHOULD give identical results and take about the same time to calculate

Code: 
Sub TotalRecordCount()

Dim lngR As Long, lngC As Long
Dim tdf As DAO.TableDef

For Each tdf In CurrentDb.TableDefs
        lngR = lngR + tdf.RecordCount
Next tdf

Debug.Print "1. Total records = " & lngR

For Each tdf In CurrentDb.TableDefs
        lngC = lngC + DCount("*", tdf.Name)
Next tdf

Debug.Print "2. Total records = " & lngC

End Sub

With the small non-split database I got:
1. Total records = 15956
2. Total records = 15956
The calculation was almost instantaneous

However, for the monster database, I got this :
1. Total records = 105124
2. Total records = 4590143

Magic - I've just gained almost 4.5 million records! Just like that ...:confused:
The first calculation was again instantaneous but very wrong.
I know for a fact that a couple of tables have over a million records
The second took much longer but is I believe likely to be correct

The obvious difference (apart from size) is that the 2nd database is split with a SQL backend as well as links to 3 other Access BE databases

So my question is why doesn't 'tdf.RecordCount' work correctly in this case?

I would be grateful if others could test the same code on both small & large databases (split & unsplit) and see whether you also get discrepancies?
 
Last edited:
Hi Jack

Yes it explains everything ... though not very clearly written by Microsoft!

You can use .RecordCount on linked tables by using a recordset
This code does work:

Code: 
Dim rst As DAO.Recordset
For Each tdf In CurrentDb.TableDefs
    Set rst = CurrentDb.OpenRecordset(tdf.Name, dbOpenSnapshot)
    On Error Resume Next
    rst.MoveLast
    'Debug.Print tdf.Name, rst.RecordCount
    lngR = lngR + rst.RecordCount
    On Error GoTo 0
Next tdf

Set rst = Nothing

Result:
Total records = 4590281 Time taken = 103 seconds

However looping through using DCount was MUCH faster - never thought I'd say that!

For Each tdf In CurrentDb.TableDefs
'Debug.Print tdf.Name, DCount("*", tdf.Name)
lngC = lngC + DCount("*", tdf.Name)
Next tdf

Result:
2. Total records = 4590281 Time taken = 5 seconds

No contest really!
 
Problem solved.

As mentioned in the last post, you can't use .RecordCount for linked tables unless you use a recordset. Even if you do so, its MUCH slower than using DCount.

I've uploaded my version to the same code repository thread as George
https://www.access-programmers.co.uk/forums/showthread.php?t=296860

Its also attached to this post
 

Attachments

Last edited:
You must log in or register to reply here.

Similar threads

B
Mapping VBA Code to show tables affected by VBA
2
Replies
29
Views
685
Pat Hartman
P
B
Solved From Access VBA an Output to Excel that filters the Output
Replies
11
Views
250
BenMason
B
C
Quickly copy Excel rows to Access
Replies
12
Views
261
CJ_London
C
K
Solved linking text box with after_update procedure using VBA.
Replies
17
Views
422
Kingz
K
D
Best way to test for no records in query
Replies
10
Views
277
Design by Sue
D

Users who are viewing this thread

Total: 1 (members: 0, guests: 1)
Back
Top Bottom