Option Compare Database
Option Explicit
Dim bIsLoaded As Boolean
'Iterate through forms
Public Sub tagsAllForms()
On Error GoTo Err_tagsAllForms
Dim oForm As Form
Dim nItem As Long
For nItem = 0 To CurrentProject.AllForms.Count - 1
'On Error Resume Next
If IsFormLoaded(CurrentProject.AllForms(nItem).Name) Then bIsLoaded = True
If Not bIsLoaded Then
' On Error Resume Next
DoCmd.OpenForm CurrentProject.AllForms(nItem).Name, acDesign, , , , acHidden
End If
Set oForm = Forms(CurrentProject.AllForms(nItem).Name)
changeTag oForm.Name
If Not bIsLoaded Then
On Error Resume Next
DoCmd.Close acForm, oForm.Name
End If
Next
MsgBox "Successfully updated audit trail in all forms.", vbInformation + vbOKOnly, gtstrAppTitle
Exit_tagsAllForms:
Exit Sub
Err_tagsAllForms:
MsgBox Err.Description, vbExclamation, "tagsAllForms Error " & Err.Number
Resume Exit_tagsAllForms
End Sub
'Change tags to audit
Public Sub changeTag(sForm As String)
On Error GoTo Err_changeTag
Dim aO As AccessObject
Dim fm As Access.Form
Dim ct As Access.Control
For Each aO In CurrentProject.AllForms
If aO.Name = sForm Then
Set fm = Forms(aO.Name)
For Each ct In fm.Controls
If isBound(ct) Then
ct.Tag = "audit"
End If
Next ct
Set fm = Nothing
If Not bIsLoaded Then
On Error Resume Next
DoCmd.Close acForm, aO.Name, acSaveYes
End If
Exit For
End If
Next
Exit_changeTag:
Exit Sub
Err_changeTag:
MsgBox Err.Description, vbExclamation, "changeTag Error " & Err.Number
Resume Exit_changeTag
End Sub
'Check if control is bound
Public Function isBound(ctl As Control) As Boolean
On Error GoTo Err_isBound
Const cBoundControls As String = _
"|Textbox|Combobox|Listbox|CheckBox|OptionButton|ToggleButton|"
Dim ctlTypName As String, ctlSource As String
ctlTypName = "|" & TypeName(ctl) & "|"
isBound = False
If InStr(1, cBoundControls, ctlTypName) <> 0 Then
ctlSource = ctl.ControlSource
If Len(ctlSource) > 0 Then
If Left$(ctlSource, 1) <> "=" Then
'the control is bound
isBound = True
End If
End If
End If
Exit_isBound:
Exit Function
Err_isBound:
MsgBox Err.Description, vbExclamation, "isBound Error " & Err.Number
Resume Exit_isBound
End Function