Provided by Allen Browne, January 2008. Updated February 2009.
If you are asked to maintain a database that uses macros, how do you find where the macros are used? You need to look in the event properties of all the controls on all the form, as well as the properties of the form itself, and its sections, as well as the reports and their sections and control properties.
The code looks in all these places, and creates a temporary table to hold the results. The fields are:
| Field Name | Description | Sample Content |
| MacroSearchID | AutoNumber (primary key) | 1 |
| DocType | The word 'Form' or 'Report' | Form |
| DocName | Name of the form or report | Form22 |
| ObjTypeName | The type of object that has this property | Command Button |
| ObjName | The name of the object | Command33 |
| PropName | Name of the property that calls a macro | OnClick |
| PropValue | Name of the macro | Macro44 |
It does not identify macros called by code or other macros - only the event properties that call macros.
To use it:
Option Compare Database
Option Explicit
Public Function FindMacrosInFormReports() As Long
'Purpose: Identify the events in forms and reports that use macros.
'Results: Creates a table named aMacroSearch, and appends the information there.
'Return: Number of properties that refer to macros.
'Versions: Requires Access 2000 or later. (In 2000, remove this from the Reports part:
' , WindowMode:=acHidden
'Notes: 1. Any existing data in aMacroSearch is deleted.
' 2. Does not find macros called in other macros, nor in code, nor in toolbars.
'Author: Allen J Browne (allen@allenbrowne.com) January, 2008.
Dim accObj As AccessObject 'Forms and reports in current project
Dim obj As Object 'Used for forms and reports.
Dim ctl As Control 'Controls on forms/reports
Dim db As DAO.Database 'Current database.
Dim rs As DAO.Recordset 'Temp table to append to.
Dim strSql As String 'SQL statements
Dim strDoc As String 'Name of form/report
Dim strDocType As String 'Type of document (form or report)
Dim i As Integer 'Loop counter
Dim lngKt As Long 'Number of properties found
Const strcTempTable = "aMacroSearch" 'Name of temp table.
'**********************************************
'Set up temp table to show results in.
'**********************************************
Set db = CurrentDb()
If TableExists(strcTempTable, db) Then
'Empty the temp table if it exists.
strSql = "DELETE FROM " & strcTempTable & ";"
Else
'Create the temp table if it does not exist.
strSql = "CREATE TABLE " & strcTempTable & " " & vbCrLf & _
"(MacroSearchID COUNTER CONSTRAINT PrimaryKey PRIMARY KEY, " & vbCrLf & _
"DocType TEXT(64), " & vbCrLf & _
"DocName TEXT(64), " & vbCrLf & _
"ObjTypeName TEXT(64), " & vbCrLf & _
"ObjName TEXT(64), " & vbCrLf & _
"PropName TEXT(64), " & vbCrLf & _
"PropValue TEXT(64));"
End If
db.Execute strSql, dbFailOnError
'Open the temp table to write to.
Set rs = db.OpenRecordset(strcTempTable, dbOpenDynaset)
'**********************************************
'Search the Forms
'**********************************************
strDocType = "Form"
For Each accObj In CurrentProject.AllForms
strDoc = accObj.Name
DoCmd.OpenForm strDoc, acDesign, WindowMode:=acHidden
'Check the properties of the form
Set obj = Forms(strDoc)
lngKt = lngKt + EventPropMacro(obj, strDocType, strDoc, strDocType, rs)
'Check the properties of the sections
For i = 0 To 20
If HasSection(obj, i) Then
lngKt = lngKt + EventPropMacro(obj.Section(i), strDocType & " Section", strDoc, strDocType, rs)
End If
Next
'Check the properties of the controls
For Each ctl In obj.Controls
lngKt = lngKt + EventPropMacro(ctl, ControlTypeName(ctl.ControlType), strDoc, strDocType, rs)
Next
'Clean up this object.
Set ctl = Nothing
Set obj = Nothing
DoCmd.Close acForm, strDoc
Next
Set accObj = Nothing
'**********************************************
'Search the Reports
'**********************************************
strDocType = "Report"
For Each accObj In CurrentProject.AllReports
strDoc = accObj.Name
DoCmd.OpenReport strDoc, acDesign, WindowMode:=acHidden
'Check the properties of the report
Set obj = Reports(strDoc)
lngKt = lngKt + EventPropMacro(obj, strDocType, strDoc, strDocType, rs)
'Check the properties of the sections
For i = 0 To 20
If HasSection(obj, i) Then
lngKt = lngKt + EventPropMacro(obj.Section(i), strDocType & " Section", strDoc, strDocType, rs)
End If
Next
'Check the properties of the controls
For Each ctl In obj.Controls
lngKt = lngKt + EventPropMacro(ctl, ControlTypeName(ctl.ControlType), strDoc, strDocType, rs)
Next
'Clean up this object.
Set ctl = Nothing
Set obj = Nothing
DoCmd.Close acReport, strDoc
Next
Set accObj = Nothing
'**********************************************
'Clean up and show results.
'**********************************************
rs.Close
Set rs = Nothing
Set db = Nothing
FindMacrosInFormReports = lngKt
DoCmd.OpenTable strcTempTable
End Function
Private Function TableExists(strTable As String, db As DAO.Database) As Boolean
'Purpose: Return True if the table exists in the database.
'Arguments: strTable = name of table
' db = the database to look in (e.g. CurrentDb)
Dim strDummy As String
On Error Resume Next
strDummy = db.TableDefs(strTable).Name
TableExists = (Err.Number <> 3265&)
End Function
Private Function EventPropMacro(obj As Object, strObjDescrip As String, strDoc As String, strDocType As String, rs As DAO.Recordset) As Long
Dim prp As DAO.Property
Dim strPropName As String
Dim strPropValue As String
Dim lngKt As Long
For Each prp In obj.Properties
strPropName = prp.Name
If (strPropName Like "On*") Or (strPropName Like "Before*") Or (strPropName Like "After*") Then
strPropValue = prp.Value
If (strPropValue <> vbNullString) And (strPropValue <> "[Event Procedure]") And Not (strPropValue Like "=*") Then
rs.AddNew
rs!DocType = strDocType
rs!DocName = strDoc
rs!ObjTypeName = strObjDescrip
rs!ObjName = obj.Name
rs!PropName = strPropName
rs!PropValue = strPropValue
rs.Update
lngKt = lngKt + 1&
'Debug.Print strObjDescrip, strDoc, obj.Name, strPropName, strPropValue
End If
End If
Next
EventPropMacro = lngKt
End Function
Private Function HasSection(obj As Object, iSection As Integer) As Boolean
Dim strDummy As String
On Error Resume Next
strDummy = obj.Section(iSection).Name
HasSection = (Err.Number <> 2462&)
End Function
Private Function ControlTypeName(lngControlType As AcControlType) As String
'On Error GoTo Err_Handler
'Purpose: Return the name of the ControlType.
'Argument: A Long Integer that is one of the acControlType constants.
'Return: A string describing the type of control.
'Note: The ControlType is a Byte, but the constants are Long.
Dim strReturn As String
Select Case lngControlType
Case acBoundObjectFrame: strReturn = "Bound Object Frame"
Case acCheckBox: strReturn = "Check Box"
Case acComboBox: strReturn = "Combo Box"
Case acCommandButton: strReturn = "Command Button"
Case acCustomControl: strReturn = "Custom Control"
Case acImage: strReturn = "Image"
Case acLabel: strReturn = "Label"
Case acLine: strReturn = "Line"
Case acListBox: strReturn = "List Box"
Case acObjectFrame: strReturn = "Object Frame"
Case acOptionButton: strReturn = "Object Button"
Case acOptionGroup: strReturn = "Option Group"
Case acPage: strReturn = "Page (of Tab)"
Case acPageBreak: strReturn = "Page Break"
Case acRectangle: strReturn = "Rectangle"
Case acSubform: strReturn = "Subform/Subrport"
Case acTabCtl: strReturn = "Tab Control"
Case acTextBox: strReturn = "Text Box"
Case acToggleButton: strReturn = "Toggle Button"
Case Else: strReturn = "Unknown: type" & lngControlType
End Select
ControlTypeName = strReturn
Exit_Handler:
Exit Function
Err_Handler:
MsgBox "Error " & Err.Number & ": " & Err.Description, vbExclamation, "ControlTypeName()"
Resume Exit_Handler
End Function
Public Function UnusedMacros()
'Assumes FindMacrosInFormReports has already been run.
'Does not find macros called in other macros, nor in code, nor in toolbars.
Dim db As DAO.Database
Dim doc As DAO.Document
Dim rs As DAO.Recordset
Dim strWhere As String
Dim lngKt As Long
Set db = DBEngine(0)(0)
Set rs = db.OpenRecordset("SELECT aMacroSearch.* FROM aMacroSearch ORDER BY PropValue;")
For Each doc In db.Containers("Scripts").Documents
strWhere = "(PropValue = """ & doc.Name & """) OR (PropValue Like """ & doc.Name & ".*"")"
rs.FindFirst strWhere
If rs.NoMatch Then
lngKt = lngKt + 1&
Debug.Print lngKt, doc.Name
End If
Next
rs.Close
Set rs = Nothing
Set db = Nothing
UnusedMacros = lngKt
End Function
| Home | Index of tips | Top |