Option Compare Database
Option Explicit
Public Sub RemoveTimers()
Dim rs As DAO.Recordset
Dim frm As Form
Dim ao As AccessObject
Dim eSave As AcCloseSave
On Error GoTo RemoveTimers_Error
'SetMDIBackGround (15525849) ' lt blue
'SetMDIBackGround (14869439) ' lt blue/green
SetMDIBackGround (13170685) ' lt yellow
'Echo False
DoCmd.SetWarnings False
Set rs = CurrentDb.OpenRecordset("USysSavedTimerIntervals", dbOpenDynaset)
For Each ao In CurrentProject.AllForms
DoCmd.OpenForm ao.Name, acDesign, , , , acHidden
Set frm = Forms(ao.Name)
If frm.TimerInterval <> 0 Then
rs.AddNew
rs!FormName = frm.Name
rs!TimerInterval = frm.TimerInterval
Debug.Print rs!FormName, rs!TimerInterval
rs.Update
frm.TimerInterval = 0
eSave = acSaveYes
Else
eSave = acSaveNo
End If
DoCmd.Close acForm, frm.Name, eSave
Next
'Echo True
rs.Close
DoCmd.SetWarnings True
On Error GoTo 0
Exit Sub
RemoveTimers_Error:
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure RemoveTimers of Module Module11"
DoCmd.SetWarnings True
End Sub
Public Sub RestoreTimers()
Dim rs As DAO.Recordset
On Error GoTo RestoreTimers_Error
Set rs = CurrentDb.OpenRecordset("USysSavedTimerIntervals")
'Echo False
Do Until rs.EOF
DoCmd.OpenForm rs!FormName, acDesign, , , , acHidden
Forms(rs!FormName).TimerInterval = rs!TimerInterval
Debug.Print rs!FormName, rs!TimerInterval
DoCmd.Close acForm, rs!FormName, acSaveYes
rs.MoveNext
Loop
' Echo True
rs.Close
SetMDIBackGround (15525849) ' lt blue
'SetMDIBackGround (14869439) ' lt blue/green
'SetMDIBackGround (13170685) ' lt yellow
DoCmd.SetWarnings False
DoCmd.OpenQuery "USysDeleteTimerData"
DoCmd.SetWarnings True
On Error GoTo 0
Exit Sub
RestoreTimers_Error:
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure RestoreTimers of Module Module11"
End Sub