Solved log off users at certain time (1 Viewer)

Pat Hartman

Super Moderator
Staff member
Local time
Today, 04:57
Joined
Feb 19, 2002
Messages
43,275
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
 

Users who are viewing this thread

Top Bottom