- Local time
- Today, 14:40
- Joined
- Feb 19, 2002
- Messages
- 45,770
Code:
Option Compare Database
Option Explicit
Public Sub RemoveTimers()
''' When testing an application, it is very important to not have any timers running so
''' unless you are actually testing the timer, it is best to turn them all off and then back on when you exit.
Dim rs As DAO.Recordset
Dim frm As Form
Dim AO As AccessObject
Dim eSave As AcCloseSave
On Error GoTo RemoveTimers_Error
Echo False
DoCmd.SetWarnings False
DoCmd.OpenQuery "USysDeleteTimerData"
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"
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
On Error GoTo 0
Exit Sub
RestoreTimers_Error:
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure RestoreTimers of Module Module11"
End Sub