Attribute VB_Name = "modAllCodeToTextFile"
Option Compare Database
Option Explicit

Private intMdlLines As Integer

'---------------------------------------------------------------------------------------
' Procedure : SaveAllCodeToFile
' Purpose   : Saves all Database Code in a text file in alphabetical order of Module names.
'           : Modules are grouped first by Forms, then Reports, followed by Standard and
'           : Class modules grouped together.
'           : This order makes it easier to compare Databases and find Modules.
'           : Form modules are prefixed with "Form_" and Report modules with "Report_".
'           : All Modules are included except Modules without code. Blank lines and
'           : Comment lines in Modules with code are included in file and in totals.
' Returns   : Grand total number of lines in modules, File name, and Folder path.
' Author    : Patrick Wood - Gaining Access Technologies - http://gainingaccess.net
'           : Inspired by Remou "Example: Output all code to desktop"
'           : http://forum.lessthandot.com/viewtopic.php?f=95&t=379
' Date      : Modified by Patrick Wood 2/14/2014.
' Usage     : You may use this code in your applications if you keep this header intact.
' Examples  : Call SaveAllCodeToFile("C:\MyCode\", "txt")
'           : Call SaveAllCodeToFile(CurrentProject.Path, "txt", False)
'           : Call SaveAllCodeToFile()
'           : ?SaveAllCodeToFile() -- Use in Immediate Window.
'---------------------------------------------------------------------------------------
'
Public Function SaveAllCodeToFile( _
            Optional strFolder As String = "", _
            Optional strFileExt As String = "txt", _
            Optional blnCountLines As Boolean = True) As String
    
On Error GoTo ErrHandle

    Dim fso As Object             'FileSystemObject
    Dim fsoTS As Object           'FileSystemObject TextStream
    Dim i As Integer
    Dim lngCount As Long
    Dim intMdlCount As Integer
    Dim strMdlName As String
    Dim strFilePath As String
    Dim strFileName As String
    Dim strDate As String
    Dim strCode As String
    Dim strMsg As String

    ' Use a unique file name with the database name plus date and time.
    strFileName = Replace(CurrentProject.Name, ".", "-")
    strDate = Format$(Now(), "yyyy\-mm\-dd\_hh\-nn\_AMPM")
    strFileName = strFileName & "_" & strDate & "." & strFileExt
    
    If Len(strFolder & "") = 0 Then
        strFolder = CurrentProject.Path & "\"
    Else
        ' Add \ to the end of the folder path if needed.
        If Right$(strFolder, 1) <> "\" Then
            strFolder = strFolder & "\"
        End If
    End If

    ' Put together the file name.
    strFilePath = (strFolder & strFileName)

    ' Set up the file.
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    ' Create an ASCII File and TextStream.
    ' Note: This writes over any existing file with the same name.
    ' To avoid writing over existing files use this code:
    ' Set fsoTS = fso.CreateTextFile(strFilePath, False)
    ' The Developer documentation states that if the Overwrite argument is
    ' left blank existing files will not be overwritten. That is NOT correct.
    Set fsoTS = fso.CreateTextFile(strFilePath)

    fsoTS.WriteLine "Database: " & CurrentProject.Name
    fsoTS.WriteLine "Path: " & CurrentProject.FullName
    fsoTS.WriteLine "DateTime: " & Now() & vbCrLf

    ' Start with Forms that have code in Alphabetical Order.
    For i = 0 To CurrentDb.Containers("Forms").Documents.Count - 1
    
        ' Get the Module Name.
        strMdlName = "Form_" & CurrentDb.Containers("Forms").Documents(i).Name
    
        ' Get the Module Code.
        strCode = GetModuleCode(strMdlName, blnCountLines)
        
        ' Write to the file only if a Module has code.
        If Len(strCode & "") > 0 Then
        
            ' Write the Module Code to the file.
            fsoTS.WriteLine strCode

            ' Get the number of code Lines.
            If blnCountLines = True Then
                lngCount = lngCount + intMdlLines
            End If
            
            intMdlCount = intMdlCount + 1
        End If
    Next i
    
    ' Save Report Modules that have code in Alphabetical Order.
    For i = 0 To CurrentDb.Containers("Reports").Documents.Count - 1
    
        ' Get the Module Name.
        strMdlName = "Report_" & CurrentDb.Containers("Reports").Documents(i).Name
    
        ' Get the Module Code.
        strCode = GetModuleCode(strMdlName, blnCountLines)
        
        ' Write to the file only if a Module has code.
        If Len(strCode & "") > 0 Then
        
            ' Write the Module Code to the file.
            fsoTS.WriteLine strCode

            ' Get the number of code Lines.
            If blnCountLines = True Then
                lngCount = lngCount + intMdlLines
            End If
            
            intMdlCount = intMdlCount + 1
        End If
    Next i
    
    ' Get the Stamdard and Class Modules Code in Alphabetical Order together.
    For i = 0 To CurrentDb.Containers("Modules").Documents.Count - 1
        
        ' Get the Module Name.
        strMdlName = CurrentDb.Containers("Modules").Documents(i).Name
        
        ' Get the Module Code.
        strCode = GetModuleCode(strMdlName, blnCountLines)
        
        ' Write to the file only if a Module has code.
        If Len(strCode & "") > 0 Then
        
            ' Write the Module Code to the file.
            fsoTS.WriteLine strCode

            ' Get the number of code Lines.
            If blnCountLines = True Then
                lngCount = lngCount + intMdlLines
            End If
            
            intMdlCount = intMdlCount + 1
        End If
    Next i
    
    fsoTS.WriteLine "Grand Total Lines of Code: " & lngCount
    
    strMsg = lngCount & " lines of Code from " & intMdlCount _
        & " Modules has been saved in file: " & vbCrLf & vbCrLf _
        & strFileName & vbCrLf & vbCrLf & "Folder: " & strFolder
        
    SaveAllCodeToFile = strMsg
    
    MsgBox strMsg, vbInformation

ExitHere:
    ' Close eveything.
    On Error Resume Next
    fsoTS.Close
    Set fsoTS = Nothing
    Set fso = Nothing
    Exit Function

ErrHandle:
    MsgBox "Error " & Err.Number & ": " & Err.Description & vbCrLf _
    & "In Procedure SaveAllCodeToFile of modAllCodeToTextFile"
    Resume ExitHere
    Resume
End Function

'---------------------------------------------------------------------------------------
' Procedure : GetModuleCode
' Author    : Patrick Wood - Gaining Access Technologies - http://gainingaccess.net/
' Date      : 2/10/2015
' Purpose   : Returns the code and Name of the specified Module.
'---------------------------------------------------------------------------------------
'
Public Function GetModuleCode(strMdlName As String, Optional blnCountLines As Boolean = True) As String
On Error GoTo ErrHandle

    Dim i As Integer
    Dim strCode As String
    Dim strReturn As String
    
    strReturn = "" 'Default Value.
    intMdlLines = 0 'Default Value.
    
    ' Get the Modules CountOfLines value.
    i = Nz(VBE.ActiveVBProject.VBComponents(strMdlName).CodeModule.CountOfLines, 0)
    
    ' Get the code in a string ...
    strCode = VBE.ActiveVBProject.VBComponents(strMdlName).CodeModule.Lines(1, i)
    
    'Use a row of equal signs above and below each Module Name.
    strReturn = String$(55, "=") & vbCrLf & strMdlName & vbCrLf
    
    'Include if showing Count of Code Lines in Module.
    If blnCountLines = True Then
        'Store Count of Module Lines using Module Variable.
        intMdlLines = i
        strReturn = strReturn & "Total lines of code in Module: " & i & vbCrLf
    End If
    strReturn = strReturn & String$(55, "=") & vbCrLf & strCode & vbCrLf

    GetModuleCode = strReturn

ExitHere:
    Exit Function

ErrHandle:
    If Err.Number = 9 Then
        'Form or Report Module has no code - skip.
        Err.Clear
    Else
        MsgBox "Error " & Err.Number & ": " & Err.Description & vbCrLf _
        & "In Procedure GetModuleCode of modAllCodeToTextFile."
    End If
    Resume ExitHere
    Resume
End Function


'---------------------------------------------------------------------------------------
' Procedure : CodeLinesCountSave
' Author    : Patrick Wood - Gaining Access Technologies - http://gainingaccess.net
'           : Inspired by Remou "Example: Output all code to desktop"
'           : http://forum.lessthandot.com/viewtopic.php?f=95&t=379
' Date      : 1/2/2012, 5/13/2014
' Purpose   : Returns the total lines of code in a Database. Blank lines and Comment only
'           : lines are not counted. The results are saved in a text file in the folder
'           : containing the database. The file contains the Module Names and the number
'           : of lines of code in each module.
' Example   : Call CodeLinesCountSave(), Debug.Print CodeLinesCountSave
'---------------------------------------------------------------------------------------
'
Public Function CodeLinesCountSave() As Long
On Error GoTo ErrHandle

    Dim fso As Object               ' FileSystemObject
    Dim fsoTS As Object             ' FileSystemObject TextStream
    Dim mdl As Object               ' Object to avoid raising error.
    Dim i As Long
    Dim lngCountofLines As Long
    Dim lngLineCount As Long
    Dim strFilePath As String
    Dim strFileName As String
    Dim strDate As String
    Dim strLine 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 fsoTS = fso.CreateTextFile(strFilePath)

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

    ' Loop through each Module in the project.
    For Each mdl In VBE.ActiveVBProject.VBComponents
        lngLineCount = 0
        ' Get the number of lines of code in the Module.
        lngCountofLines = VBE.ActiveVBProject.VBComponents(mdl.Name).CodeModule.CountOfLines
        
        ' Check each line in the Module for code.
        For i = 1 To lngCountofLines
            strLine = VBE.ActiveVBProject.VBComponents(mdl.Name).CodeModule.Lines(i, 1)
            If Len(Trim$(strLine) & "") = 0 Then
                ' Blank line, skip it.
            ElseIf Left$(Trim$(strLine), 1) = "'" Then
                ' Comment line, skip it.
            Else
                lngLineCount = lngLineCount + 1
            End If
        Next i

        ' Add the number of lines in the Module to the count.
        lngTotalLines = lngTotalLines + lngLineCount
        ' Write the information in the text file.
        fsoTS.WriteLine lngLineCount & Space(5 - Len(CStr(lngLineCount))) & " " & mdl.Name
    Next mdl

    fsoTS.WriteLine "-------------------------------------"
    fsoTS.WriteLine "Total Lines of code in Database: " & lngTotalLines
    fsoTS.WriteLine " "
    fsoTS.WriteLine "*Blank lines are excluded."

    CodeLinesCountSave = lngTotalLines

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

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

ErrHandle:
    MsgBox "Error " & Err.Number & " " & Err.Description & vbCrLf _
    & "In Procedure CodeLinesCountSave of modAllCodeToTextFile"
    Resume ExitHere
    Resume
End Function


'---------------------------------------------------------------------------------------
' Procedure : SaveFoundCodeInTextFile
' Author    : Patrick Wood  http://gainingaccess.net
' Date      : 3/31/2011
' Purpose   : Save searched Code To a Text File
'---------------------------------------------------------------------------------------
'
Public Function SaveFoundCodeInTextFile( _
        strStringToFind, _
        Optional strFolder As String = "", _
        Optional strFileExt As String = "txt") As String

On Error GoTo ErrHandle

    Dim fso As Object               ' FileSystemObject
    Dim fsoTS As Object             ' FileSystemObject TextStream
    Dim mdl As Object               ' Object to avoid raising error.
    Dim i As Integer
    Dim intEndLine As Integer
    Dim intCount As Integer
    Dim strLine As String
    Dim strFound As String
    Dim strFileName As String
    Dim strFilePath As String
    Dim strDate As String
    Dim strMsg As String

    strDate = Format(Now(), "yyyy\-mm\-dd\_hh\-nn\_AMPM")
    strFileName = Replace(CurrentProject.Name, ".", "-")
    strFileName = strFileName & "_FoundCode_" & strDate & "." & strFileExt
    
    Set fso = CreateObject("Scripting.FileSystemObject")

    ' Prepare the Folder Path.
    If Len(strFolder & "") > 0 Then
        ' Add \ to the end of the folder path if needed.
        If Right$(strFolder, 1) <> "\" Then
            strFolder = strFolder & "\"
        End If
    Else
        strFolder = CurrentProject.Path & "\"
    End If

    ' Finish the file path.
    strFilePath = (strFolder & strFileName)

    ' Create the file and TextStream.strFilePath
    Set fsoTS = fso.CreateTextFile(strFilePath)

    fsoTS.WriteLine "Database: " & CurrentProject.Name
    fsoTS.WriteLine "Path: " & CurrentProject.FullName
    fsoTS.WriteLine "DateTime: " & Now() & vbCrLf
    fsoTS.WriteLine vbCrLf & "Search String: " & strStringToFind & vbCrLf
    
    ' Search for the text in each Module.
    For Each mdl In VBE.ActiveVBProject.VBComponents
        
        ' Get the Count of Lines in the Module.
        intEndLine = VBE.ActiveVBProject.VBComponents(mdl.Name).CodeModule.CountOfLines
        ' Search for the text looping through each line in the Module.
        For i = 1 To intEndLine
            ' Get the code in this line.
            strLine = VBE.ActiveVBProject.VBComponents(mdl.Name).CodeModule.Lines(i, 1)
            ' Determine if the search string is in the code line.
            If InStr(1, strLine, strStringToFind) > 0 Then
                strFound = strFound & "(Line #" & i & ") " & strLine & vbCrLf
                intCount = intCount + 1
            End If
            
            ' Check if all code lines in this Module has been searched.
            If i = intEndLine Then
                ' Check if the search string was found in this Module.
                If Len(strFound & "") > 0 Then
                    ' Use equal signs to make the Module names easy to see.
                    strFound = "==================================================" & vbCrLf & strFound
                    strFound = mdl.Name & vbCrLf & strFound
                    strFound = "==================================================" & vbCrLf & strFound
                    fsoTS.Write strFound
                End If
            End If
        Next i
        strFound = vbNullString
    Next mdl

    strMsg = """" & strStringToFind & """ was found in " & intCount & " Lines of Code."
    
    fsoTS.WriteLine vbCrLf & strMsg
    
    strMsg = strMsg & vbCrLf & vbCrLf & "Code has been saved in File " & strFileName _
        & vbCrLf & vbCrLf & "In Folder " & strFolder
        
    SaveFoundCodeInTextFile = strMsg
    
    MsgBox strMsg, vbInformation

ExitHere:
    On Error Resume Next
    fsoTS.Close
    Set fsoTS = Nothing
    Set fso = Nothing
    Exit Function

ErrHandle:
    MsgBox "Error " & Err.Number & vbCrLf & Err.Description & vbCrLf _
    & "In procedure SaveFoundCodeInTextFile of modAllCodeToTextFile"
    Resume ExitHere
    Resume
End Function


'---------------------------------------------------------------------------------------
' Procedure : AllCodeToTextFile
' Author    : Remou http://forum.lessthandot.com/viewtopic.php?f=95&t=379 10/5/2008
' Modified  : Patrick Wood - Gaining Access Technologies - http://gainingaccess.net
' Purpose   : You can output the code from all components of your project using VBE
' Arguments : The reference for the FileSystemObject Object is Windows
'           : Script Host Object Model but it not necessary to add
'           : the reference for this procedure.
'---------------------------------------------------------------------------------------
'
Sub AllCodeToTextFile()
On Error GoTo ErrHandle

    Dim fso As Object       ' FileSystemObject
    Dim fsoTS As Object     ' FileSystemObject TextStream
    Dim mdl As Object       ' Object to avoid raising error.
    Dim strCode As String
    Dim i As Integer

    Set fso = CreateObject("Scripting.FileSystemObject")

    ' Create up the text file and TextStream.
    Set fsoTS = fso.CreateTextFile(CurrentProject.Path & "\" _
        & Replace(CurrentProject.Name, ".", "") & ".txt")

    ' For each component in the project ...
    For Each mdl In VBE.ActiveVBProject.VBComponents
        ' using the count of lines ...
        i = VBE.ActiveVBProject.VBComponents(mdl.Name).CodeModule.CountOfLines
        ' Get all the Module's code in a Variable.
        strCode = VBE.ActiveVBProject.VBComponents(mdl.Name).CodeModule.Lines(1, i)
        ' Then write the code to a file, first marking the start with
        ' some equal signs and the component name.
        fsoTS.WriteLine String(15, "=") & vbCrLf & mdl.Name _
            & vbCrLf & String(15, "=") & vbCrLf & strCode
    Next mdl

ExitHere:
    ' Close eveything.
    On Error Resume Next
    fsoTS.Close
    Set fsoTS = Nothing
    Set fso = Nothing
    Exit Sub

ErrHandle:
    MsgBox "Error " & Err.Number & ": " & Err.Description & vbCrLf _
    & "In Procedure AllCodeToTextFile of modAllCodeToTextFile"
    Resume ExitHere
    Resume
End Sub



'---------------------------------------------------------------------------------------
' Procedure : SearchSQLInQueries
' Author    : Patrick Wood - Gaining Access Technologies - http://gainingaccess.net/
' Date      : 2/24/2015
' Purpose   : Returns Query Names and SQL containing specified search string.
'           : You are welcome to use this code in your Applications and share it if you
'           : keep this header with the code. There is no warrenty expressed or implied.
'---------------------------------------------------------------------------------------
'
Public Function SearchSQLInQueries(strSearchText As String) As String
On Error GoTo ErrHandle

    Dim db As DAO.Database
    Dim qdf As DAO.QueryDef
    Dim strFound As String
    
    Set db = CurrentDb

    For Each qdf In db.QueryDefs
        If Left(qdf.Name, 1) <> "~" Then
            If InStr(1, qdf.sql, strSearchText) > 0 Then
                strFound = strFound & qdf.Name & vbCrLf
                strFound = strFound & qdf.sql & vbCrLf & vbCrLf
            End If
        End If
    Next qdf
    
    SearchSQLInQueries = strFound
    
    Set qdf = Nothing
    Set db = Nothing

ExitHere:
    Exit Function

ErrHandle:
    MsgBox "Error " & Err.Number & ": " & Err.Description & vbCrLf _
    & "In Procedure SearchSQLInQueries of modAllCodeToTextFile"
    Resume ExitHere
    Resume

End Function