Counting the number of lines of code in a database

Counting the number of lines of code in a database

If you have a large applicaiton, you may be interested to know the number of lines of code in it. Whilst you can use the .CountOfLines property for modules, this figure will include blank lines and comments. If you want a number for the actual number of lines of code in the database, then copy the code below, and save it in a module called 'mdlCountLines' in the database (if you change the name of the module, note that you will have to change the line If doc.Name <> "mdlCountLines" Then to include the new module name):

Public Function fCountLines() As Long
'   Code to count the number of lines of code in the current database
    On Error GoTo E_Handle
    Dim db As Database
    Dim ctr As Container
    Dim doc As Document
    Dim frm As Form
    Dim rpt As Report
    Dim mdl As Module
    Dim lngCount As Long
    Dim intCount As Integer, intLoop As Integer
    Set db = CurrentDb
    Set ctr = db.Containers!Forms
    For Each doc In ctr.Documents
        DoCmd.OpenForm doc.Name, acDesign, , , , acHidden
        Set frm = Forms(doc.Name)
        If frm.HasModule = True Then
            Set mdl = frm.Module
            intCount = mdl.CountOfLines
            For intLoop = 1 To intCount
                If Len(mdl.Lines(intLoop, 1)) > 0 And Left(Trim(mdl.Lines(intLoop, 1)), 1) <> "'" Then
                    lngCount = lngCount + 1
                End If
            Next intLoop
            Set mdl = Nothing
        End If
        DoCmd.Close acForm, doc.Name
        Set frm = Nothing
    Next doc
    Set ctr = db.Containers!Reports
    For Each doc In ctr.Documents
        DoCmd.OpenReport doc.Name, acViewDesign
        Set rpt = Reports(doc.Name)
        If rpt.HasModule = True Then
            Set mdl = rpt.Module
            intCount = mdl.CountOfLines
            For intLoop = 1 To intCount
                If Len(mdl.Lines(intLoop, 1)) > 0 And Left(Trim(mdl.Lines(intLoop, 1)), 1) <> "'" Then
                    lngCount = lngCount + 1
                End If
            Next intLoop
            Set mdl = Nothing
        End If
        DoCmd.Close acReport, doc.Name
        Set rpt = Nothing
    Next doc
    Set ctr = db.Containers!Modules
    For Each doc In ctr.Documents
        If doc.Name <> "mdlCountLines" Then
            DoCmd.OpenModule doc.Name
            Set mdl = Modules(doc.Name)
            intCount = mdl.CountOfLines
            For intLoop = 1 To intCount
                If Len(mdl.Lines(intLoop, 1)) > 0 And Left(Trim(mdl.Lines(intLoop, 1)), 1) <> "'" Then
                    lngCount = lngCount + 1
                End If
            Next intLoop
            DoCmd.Close acModule, doc.Name
            Set mdl = Nothing
        End If
    Next doc
    fCountLines = lngCount
fExit:
    On Error Resume Next
    Set ctr = Nothing
    Set db = Nothing
    Exit Function
E_Handle:
    MsgBox Err.Description & vbCrLf & "fCountLines", vbOKOnly + vbCritical, "Error: " & Err.Number
    Resume fExit
End Function

Top

HOME | NEW | TABLES | QUERIES | FORMS | REPORTS | GENERAL | API | DOWNLOADS | TUTORIAL | RESOURCES
E-MAIL
Copyright & Disclaimer

Last modified at 06/06/2006 14:57:22