'---------------------------------------------------------------------------------------
' Procedure : FindEmbeddedMacros
' Author : Daniel Pineault, CARDA Consultants Inc.
' Website : http://www.cardaconsultants.com
' Purpose : Search Forms & Reports to locate any Embedded Macros
' 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:
' ~~~~~~~~~~~~~~~~
' None
'
' Usage:
' ~~~~~~
' ?FindEmbeddedMacros
' Call FindEmbeddedMacros
'
' Revision History:
' Rev Date(yyyy/mm/dd) Description
' **************************************************************
' 1 2017-01-07 Initial Release
' 2 2018-05-24 Copyright updated
'---------------------------------------------------------------------------------------
Public Sub FindEmbeddedMacros()
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 prp As DAO.Property
Access.Application.Echo False
Debug.Print "Search Results"
Debug.Print "Object Type", "Object Name", "Control Name", "Event Name"
Debug.Print String(80, "-")
'Search the forms
For Each oFrm In Application.CurrentProject.AllForms
DoCmd.OpenForm oFrm.Name, acDesign
Set frm = Forms(oFrm.Name).Form
With frm
For Each prp In .Properties
'Form Properties
If InStr(prp.Name, "EMMacro") > 0 Then
If Len(prp.value) > 0 Then
Debug.Print "Form", frm.Name, , Replace(prp.Name, "EmMacro", "")
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
Debug.Print "Form", frm.Name, ctl.Name, Replace(prp.Name, "EmMacro", "")
End If
End If
Next prp
Next ctl
End With
DoCmd.Close acForm, oFrm.Name, acSaveNo
Next oFrm
'Search the 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
Debug.Print "Report", rpt.Name, , Replace(prp.Name, "EmMacro", "")
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
Debug.Print "Report", rpt.Name, ctl.Name, Replace(prp.Name, "EmMacro", "")
End If
End If
Next prp
Next ctl
End With
DoCmd.Close acReport, oRpt.Name, acSaveNo
Next oRpt
Debug.Print String(80, "-")
Debug.Print "Search Completed"
Error_Handler_Exit:
On Error Resume Next
Access.Application.Echo True
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 Sub
Error_Handler:
MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Source: FindEmbeddedMacros" & vbCrLf & _
"Error Description: " & Err.Description & _
Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
, vbOKOnly + vbCritical, "An Error has Occurred!"
Resume Error_Handler_Exit
End Sub
Ваш коментарий будет первым