During the design process in a Microsoft Access database, you may need to find where a particular label Caption is being used. Or perhaps you need to compare the Row Source of combo boxes across multiple forms. The VBA functions below provide a way to capture some control property values in table that you can view or query.
FillObjectControls() – Get property values from all controls on all Forms and Reports.
FillObjectControls_Form() – Get property values from all controls on a particular Form.
FillObjectControls_Report() – Get property values from all controls on a particular Report.
You may run the functions from the Immediate window like this:
?FillObjectControls()
Here is the list of property values that the function stores in the ObjectControls table:
• Name
• ControlType
• ControlSource
• RowSource
• Caption
• ControlTipText
• StatusBarText
• Visible
If the control has an associated label:
• Label Name
• Label Caption
If the control is a subform or subreport:
• SourceObject
Create a new code module and paste in the code below. The functions require 2 tables, which are mapped out at the top of the code.
basObjectControls
Option Compare Database
Option Explicit
'
' basObjectControls() Version 1.0.0
' Copyright © 2023 Extra Mile Data, www.extramiledata.com.
' For questions or issues, please contact [email protected].
' Use (at your own risk) and modify freely as long as proper credit is given.
'
' RUN FillObjectControls()
'
' ObjectControls
' Fields:
' ObjectControlID AutoNumber
' ObjectType
' ObjectName
' ParentObjectName
' ObjectCaption
' ControlName
' ControlControlTypeID Long Integer
' ControlControlType
' ControlControlSource
' ControlRowSource Long Text
' ControlSourceObject
' ControlCaption
' ControlControlTipText
' ControlStatusBarText
' ControlVisible
' ControlLabelName
' ControlLabelCaption
' Processed Yes/No
'
' AccessControlTypes
' Fields:
' ControlTypeConstant
' ControlTypeName
' ControlTypeID Long Integer
' Records:
' 1) Copy to Notepad
' 2) Replace spaces between columns with Tab
' 3) Copy results and paste into AccessControlTypes
'
' acAttachment Attachment 126
' acBoundObjectFrame Bound object frame 108
' acCheckBox Check box 106
' acComboBox Combo box 111
' acCommandButton Command button 104
' acCustomControl ActiveX (custom) control 119
' acEmptyCell Empty Cell 127
' acImage Image 103
' acLabel Label 100
' acLine Line 102
' acListBox List box 110
' acNavigationButton Navigation button 130
' acNavigationControl Navigation control 129
' acObjectFrame Unbound object frame or chart 114
' acOptionButton Option button 105
' acOptionGroup Option group 107
' acPage Page 124
' acPageBreak Page break 118
' acRectangle Rectangle 101
' acSubform Subform/subreport 112
' acTabCtl Tab 123
' acTextBox Text box 109
' acToggleButton Toggle button 122
' acWebBrowser Web browser 128
'
Public Function FillObjectControls(Optional ClearTable As Boolean = True) As Boolean
' This procedure fills the ObjectControls table with control info from
' all Forms and Reports.
' If ClearTable is True, then it empties ObjectControls before starting.
On Error GoTo Err_Handler
Dim strSQL As String
Dim aob As AccessObject
Dim lngCount As Long
Dim lngTotalCount As Long
If ClearTable Then
strSQL = "DELETE * FROM ObjectControls"
CurrentDb.Execute strSQL, dbFailOnError
End If
lngTotalCount = CurrentProject.AllForms.Count + CurrentProject.AllReports.Count
lngCount = 0
' Loop through the Forms.
For Each aob In CurrentProject.AllForms
FillObjectControls_Form aob.Name
lngCount = lngCount + 1
If lngCount Mod 10 = 0 Then
Debug.Print lngCount & " of " & lngTotalCount
DoEvents
End If
Next
' Loop through the Reports.
For Each aob In CurrentProject.AllReports
FillObjectControls_Report aob.Name
lngCount = lngCount + 1
If lngCount Mod 10 = 0 Then
Debug.Print lngCount & " of " & lngTotalCount
DoEvents
End If
Next
' Update ControlControlType.
strSQL = "UPDATE ObjectControls INNER JOIN AccessControlTypes " _
& "ON ObjectControls.ControlControlTypeID = AccessControlTypes.ControlTypeID " _
& "SET ObjectControls.ControlControlType = [AccessControlTypes].[ControlTypeName];"
CurrentDb.Execute strSQL, dbFailOnError
FillObjectControls = True
Exit_Proc:
On Error Resume Next
Set aob = Nothing
Exit Function
Err_Handler:
MsgBox Err.Number & " " & Err.Description, vbCritical, "FillObjectControls()"
FillObjectControls = False
Resume Exit_Proc
End Function
'
Public Function FillObjectControls_Form(FormName As String, _
Optional ClearTable As Boolean = False) As Boolean
' This procedure fills the ObjectControls table with control info for
' the FormName form.
' If ClearTable is True, then it empties ObjectControls before starting.
On Error GoTo Err_Handler
Dim strSQL As String
Dim frm As Form
Dim rst As DAO.Recordset
Dim ctl As Control
Dim ctlLabel As Control
Dim strFormName As String
Dim strControlSourceObject As String
Dim strObjectType As String
Dim intPos As Integer
Dim varParentObjectname
Dim strWhere As String
If ClearTable Then
strSQL = "DELETE * FROM ObjectControls"
CurrentDb.Execute strSQL, dbFailOnError
End If
' See if the form already exists in the table. If it does, then exit.
' Otherwise, add it unprocessed to the table.
strWhere = "ObjectType='Form' AND ObjectName='" & FormName & "'"
If DCount("ObjectControlID", "ObjectControls", strWhere) > 0 Then
FillObjectControls_Form = True
GoTo Exit_Proc
Else
strSQL = "INSERT INTO ObjectControls ( " _
& "ObjectType, " _
& "ObjectName, " _
& "Processed ) " _
& "VALUES ( " _
& "'Form', " _
& "'" & FormName & "', " _
& "False )"
CurrentDb.Execute strSQL, dbFailOnError
End If
strWhere = "ObjectType='Form' AND Processed=False"
Do While DCount("ObjectControlID", "ObjectControls", strWhere) > 0
strSQL = "SELECT * FROM ObjectControls WHERE Processed = False"
Set rst = CurrentDb.OpenRecordset(strSQL)
With rst
.MoveFirst
strFormName = Nz(!ObjectName, "")
If Len(strFormName) = 0 Then
.Edit
!Processed = True
.Update
Else
varParentObjectname = !ParentObjectName
DoCmd.OpenForm strFormName, acDesign, , , , acHidden
Set frm = Forms(strFormName)
.Edit
!ObjectCaption = frm.Caption
!Processed = True
.Update
For Each ctl In frm.Controls
On Error Resume Next
.AddNew
!ObjectType = "Form"
!ParentObjectName = varParentObjectname
!ObjectName = strFormName
!ControlName = ctl.Name
!ControlControlTypeID = ctl.ControlType
!ControlControlSource = ctl.ControlSource
!ControlRowSource = ctl.RowSource
!ControlCaption = ctl.Caption
!ControlControlTipText = ctl.ControlTipText
!ControlStatusBarText = ctl.StatusBarText
!ControlVisible = ctl.Visible
If ctl.Controls.Count > 0 Then
Set ctlLabel = ctl.Controls.Item(0)
!ControlLabelName = ctlLabel.Name
!ControlLabelCaption = ctlLabel.Caption
End If
' If this is a subform, add a new Form record.
If ctl.ControlType = 112 Then
strControlSourceObject = ctl.SourceObject
intPos = InStr(1, strControlSourceObject, ".")
If intPos > 0 Then
strObjectType = Left(strControlSourceObject, intPos - 1)
strControlSourceObject = Right(strControlSourceObject, _
Len(strControlSourceObject) - intPos)
Else
strObjectType = "Form"
End If
!ControlSourceObject = strControlSourceObject
strSQL = "INSERT INTO ObjectControls ( " _
& "ObjectType, " _
& "ObjectName, " _
& "ParentObjectName, " _
& "Processed ) " _
& "VALUES ( " _
& "'" & strObjectType & "', " _
& "'" & strControlSourceObject & "', " _
& "'" & strFormName & "', " _
& "False )"
CurrentDb.Execute strSQL, dbFailOnError
End If
!Processed = True
.Update
On Error GoTo Err_Handler
Next ctl
DoCmd.Close acForm, strFormName, acSaveNo
End If
.Close
End With ' rst
Loop
FillObjectControls_Form = True
Exit_Proc:
On Error Resume Next
rst.Close
DoCmd.Close acForm, strFormName, acSaveNo
Set frm = Nothing
Exit Function
Err_Handler:
MsgBox Err.Number & " " & Err.Description, vbCritical, "FillObjectControls_Form()"
FillObjectControls_Form = False
Resume Exit_Proc
Resume
End Function
'
Public Function FillObjectControls_Report(ReportName As String, _
Optional ClearTable As Boolean = False) As Boolean
' This procedure fills the ObjectControls table with control info for
' the ReportName report.
' If ClearTable is True, then it empties ObjectControls before starting.
On Error GoTo Err_Handler
Dim strSQL As String
Dim frm As Report
Dim rst As DAO.Recordset
Dim ctl As Control
Dim ctlLabel As Control
Dim strReportName As String
Dim strControlSourceObject As String
Dim strObjectType As String
Dim intPos As Integer
Dim varParentObjectname
Dim strWhere As String
If ClearTable Then
strSQL = "DELETE * FROM ObjectControls"
CurrentDb.Execute strSQL, dbFailOnError
End If
' See if the Report already exists in the table. If it does, then exit.
' Otherwise, add it unprocessed to the table.
strWhere = "ObjectType='Report' AND ObjectName='" & ReportName & "'"
If DCount("ObjectControlID", "ObjectControls", strWhere) > 0 Then
FillObjectControls_Report = True
GoTo Exit_Proc
Else
strSQL = "INSERT INTO ObjectControls ( " _
& "ObjectType, " _
& "ObjectName, " _
& "Processed ) " _
& "VALUES ( " _
& "'Report', " _
& "'" & ReportName & "', " _
& "False )"
CurrentDb.Execute strSQL, dbFailOnError
End If
strWhere = "ObjectType='Report' AND Processed=False"
Do While DCount("ObjectControlID", "ObjectControls", strWhere) > 0
strSQL = "SELECT * FROM ObjectControls WHERE Processed = False"
Set rst = CurrentDb.OpenRecordset(strSQL)
With rst
.MoveFirst
strReportName = Nz(!ObjectName, "")
If Len(strReportName) = 0 Then
.Edit
!Processed = True
.Update
Else
varParentObjectname = !ParentObjectName
DoCmd.OpenReport strReportName, acDesign, , , acHidden
Set frm = Reports(strReportName)
.Edit
!ObjectCaption = frm.Caption
!Processed = True
.Update
For Each ctl In frm.Controls
On Error Resume Next
.AddNew
!ObjectType = "Report"
!ParentObjectName = varParentObjectname
!ObjectName = strReportName
!ControlName = ctl.Name
!ControlControlTypeID = ctl.ControlType
!ControlControlSource = ctl.ControlSource
!ControlRowSource = ctl.RowSource
!ControlCaption = ctl.Caption
!ControlControlTipText = ctl.ControlTipText
!ControlStatusBarText = ctl.StatusBarText
!ControlVisible = ctl.Visible
If ctl.Controls.Count > 0 Then
Set ctlLabel = ctl.Controls.Item(0)
!ControlLabelName = ctlLabel.Name
!ControlLabelCaption = ctlLabel.Caption
End If
' If this is a subReport, add a new Report record.
If ctl.ControlType = 112 Then
strControlSourceObject = ctl.SourceObject
intPos = InStr(1, strControlSourceObject, ".")
If intPos > 0 Then
strObjectType = Left(strControlSourceObject, intPos - 1)
strControlSourceObject = Right(strControlSourceObject, _
Len(strControlSourceObject) - intPos)
Else
strObjectType = "Report"
End If
!ControlSourceObject = strControlSourceObject
strSQL = "INSERT INTO ObjectControls ( " _
& "ObjectType, " _
& "ObjectName, " _
& "ParentObjectName, " _
& "Processed ) " _
& "VALUES ( " _
& "'" & strObjectType & "', " _
& "'" & strControlSourceObject & "', " _
& "'" & strReportName & "', " _
& "False )"
CurrentDb.Execute strSQL, dbFailOnError
End If
!Processed = True
.Update
On Error GoTo Err_Handler
Next ctl
DoCmd.Close acReport, strReportName, acSaveNo
End If
.Close
End With ' rst
Loop
FillObjectControls_Report = True
Exit_Proc:
On Error Resume Next
rst.Close
DoCmd.Close acReport, strReportName, acSaveNo
Set frm = Nothing
Exit Function
Err_Handler:
MsgBox Err.Number & " " & Err.Description, vbCritical, "FillObjectControls_Report()"
FillObjectControls_Report = False
Resume Exit_Proc
Resume
End Function
Making Microsoft Access Work. Call (505) 369-1650.