'---------------------------------------------------------------------------------------

' 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