'---------------------------------------------------------------------------------------
' Procedure : CodeLinesCountSave
' Author    : Patrick Wood - Gaining Access Technologies http://gainingaccess.net/
' Date      : 1/2/2012
' Purpose   : Returns total lines of code in the Database and saves a text file in the
'           : folder containing the database with details including the Module Names
'           : and the number of lines of code in each module.
' Example   : Call CodeLinesCountSave()
'---------------------------------------------------------------------------------------
'
Function CodeLinesCountSave() As Long
On Error GoTo ErrHandle

    Dim fso As Object
    Dim fsoFile As Object
    Dim mdl As Object
    Dim i As Integer
    Dim strFilePath As String
    Dim strFileName As String
    Dim strDate As String
    Dim lngTotalLines As Long

    'Build a unique file name with the database name plus date and time
    'which will be saved in the folder where the database is located.
    strFileName = CurrentProject.Name
    strDate = Format(Now(), "yyyy-mm-dd-hh-nn")
    strFileName = Replace(strFileName, ".", "-")
    strFileName = "CountOfLines-" & strFileName & strDate & ".txt"
    strFilePath = CurrentProject.Path & "\" & strFileName

    'Create the text file
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set fsoFile = fso.CreateTextFile(strFilePath)

    fsoFile.Writeline "Date and Time Lines of Code Counted: " & Now()
    fsoFile.Writeline " "
    fsoFile.Writeline "Count of Lines   Module Name"
    fsoFile.Writeline "-------------------------------------"

    'Loop through each Module in the project
    For Each mdl In VBE.ActiveVBProject.VBComponents
        'Get the number of lines of code in the Module
        i = VBE.ActiveVBProject.VBComponents(mdl.Name).CodeModule.CountOfLines
        'Add the number of lines in the Module to the count
        lngTotalLines = lngTotalLines + i
        'Write the information in the text file
        fsoFile.Writeline i & vbTab & mdl.Name
    Next

    fsoFile.Writeline "-------------------------------------"
    fsoFile.Writeline "Total Lines of code in Database: " & lngTotalLines

    CodeLinesCountSave = lngTotalLines

    MsgBox "The info has been saved to:" & vbCrLf & strFilePath

ExitHere:
    'Release Memory
    On Error Resume Next
    fsoFile.Close
    Set fsoFile = Nothing
    Set fso = Nothing
    Exit Function

ErrHandle:
    MsgBox "Error " & Err.Number & vbCrLf & Err.Description _
    & vbCrLf & "In procedure CodeLinesCountSave"
    Resume ExitHere

End Function