'---------------------------------------------------------------------------------------
' Procedure : FindTermInMacros
' Author    : Daniel Pineault, CARDA Consultants Inc.
' Website   : http://www.cardaconsultants.com
' Purpose   : Search through Form and Report Embedded Macros and standard Macros for
'             a given term
'             The search results are printed to the immediate window
' Copyright : The following is release as Attribution-ShareAlike 4.0 International
'             (CC BY-SA 4.0) - https://creativecommons.org/licenses/by-sa/4.0/
' Req'd Refs: Uses Late Binding, so none required
'
' Input Variables:
' ~~~~~~~~~~~~~~~~
' sSearchTerm   The term to look form
'
' Usage:
' ~~~~~~
' Call FindTermInMacros("Form1")
' Call FindTermInMacros("SetTempVar")
'
' Revision History:
' Rev       Date(yyyy/mm/dd)        Description
' **************************************************************************************
' 1         2017-01-07              Initial Release
' 2         2017-05-22              Added search of standard Macros
' 3         2018-09-20              Updated Copyright
'---------------------------------------------------------------------------------------
Public Function FindTermInMacros(sSearchTerm As String)
    On Error GoTo Error_Handler
    Dim oFrm                  As Object
    Dim frm                   As Access.Form
    Dim oRpt                  As Object
    Dim rpt                   As Access.Report
    Dim ctl                   As Access.Control
    Dim oMcr                  As Object
    Dim prp                   As DAO.Property
    Dim sFile                 As String
    Dim sMcr                  As String
    Dim intChannel            As Integer
    Dim sLine                 As String
 
    Access.Application.Echo False
    Debug.Print "Search Results for the Term '" & sSearchTerm & "'"
    Debug.Print "Object Type", "Object Name", "Control Name", "Event Name"
    Debug.Print String(80, "-")
 
    'Search Forms
    For Each oFrm In Application.CurrentProject.AllForms
        DoCmd.OpenForm oFrm.Name, acDesign
        Set frm = Forms(oFrm.Name).Form
        With frm
            'Form Properties
            For Each prp In .Properties
                If InStr(prp.Name, "EmMacro") > 0 Then
                    If Len(prp.Value) > 0 Then
                        'Search for the Search Term we are looking for
                        If InStr(prp.Value, sSearchTerm) > 0 Then
                            Debug.Print "Form:", frm.Name, , Replace(prp.Name, "EmMacro", "")  ', prp.Value
                        End If
                    End If
                End If
            Next prp
            'Form Control Properties
            For Each ctl In frm.Controls
                For Each prp In ctl.Properties
                    If InStr(prp.Name, "EMMacro") > 0 Then
                        If Len(prp.Value) > 0 Then
                            If InStr(prp.Value, sSearchTerm) > 0 Then
                                Debug.Print "Form", frm.Name, ctl.Name, Replace(prp.Name, "EmMacro", "")
                            End If
                        End If
                    End If
                Next prp
            Next ctl
        End With
        DoCmd.Close acForm, oFrm.Name, acSaveNo
    Next oFrm
 
    'Search Reports
    For Each oRpt In Application.CurrentProject.AllReports
        DoCmd.OpenReport oRpt.Name, acDesign
        Set rpt = Reports(oRpt.Name).Report
        With rpt
            'Report Properties
            For Each prp In .Properties
                If InStr(prp.Name, "EmMacro") > 0 Then
                    If Len(prp.Value) > 0 Then
                        'Search for the Search Term we are looking for
                        If InStr(prp.Value, sSearchTerm) > 0 Then
                            Debug.Print "Report:", rpt.Name, , Replace(prp.Name, "EmMacro", "")  ', prp.Value
                        End If
                    End If
                End If
            Next prp
            'Report Control Properties
            For Each ctl In rpt.Controls
                For Each prp In ctl.Properties
                    If InStr(prp.Name, "EMMacro") > 0 Then
                        If Len(prp.Value) > 0 Then
                            If InStr(prp.Value, sSearchTerm) > 0 Then
                                Debug.Print "Form", frm.Name, ctl.Name, Replace(prp.Name, "EmMacro", "")
                            End If
                        End If
                    End If
                Next prp
            Next ctl
        End With
        DoCmd.Close acReport, oRpt.Name, acSaveNo
    Next oRpt
 
    'Search Standard Macros
    'There appears to be no way to simply read/access a macro's commands through VBA, so
    'we have to export the object to a text file and then read and search the resulting
    'file.  It's just the way it is, thank MS for not giving us any mean to interact with
    'macros!
    For Each oMcr In Application.CurrentProject.AllMacros
        sFile = Access.Application.CurrentProject.Path & "\Macro_" & oMcr.Name & ".txt"
        'Export the Macro to a Text file so we can review it
        Access.Application.SaveAsText acMacro, oMcr.Name, sFile
        'Read the text file
        sMcr = ""
        intChannel = FreeFile
        Open sFile For Input Access Read As #intChannel
        Do Until EOF(intChannel)
            Line Input #intChannel, sLine
            If Trim(sLine) Like "Comment =""_AXL:<?xml version=*" Then _
               Exit Do
            sMcr = sMcr & sLine
        Loop
        Close #intChannel
        'Delete the text file now that we have the content in memory
        Kill sFile
        'Search for the Search Term we are looking for
        If InStr(sMcr, sSearchTerm) > 0 Then
            Debug.Print "Macro:", oMcr.Name
        End If
    Next oMcr
 
    Debug.Print String(80, "-")
    Debug.Print "Search Completed"
 
Error_Handler_Exit:
    On Error Resume Next
    Access.Application.Echo True
    If Not oMcr Is Nothing Then Set oMcr = Nothing
    If Not prp Is Nothing Then Set prp = Nothing
    If Not ctl Is Nothing Then Set ctl = Nothing
    If Not rpt Is Nothing Then Set rpt = Nothing
    If Not oRpt Is Nothing Then Set oRpt = Nothing
    If Not frm Is Nothing Then Set frm = Nothing
    If Not oFrm Is Nothing Then Set oFrm = Nothing
    Exit Function
 
Error_Handler:
    MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
           "Error Number: " & Err.Number & vbCrLf & _
           "Error Source: FindTermInMacros" & vbCrLf & _
           "Error Description: " & vbCrLf & _
           Switch(Erl = 0, "", Erl <> 0, vbCrLf) _
           , vbOKOnly + vbCritical, "An Error has Occurred!"
    Resume Error_Handler_Exit
End Function