Closing Database after 10 minutes of Idle Time

[MHamid]

Hello,

I am using the below code to close the database after 10 minutes of idle time.
The issue I am having is that once the database closes after 10 minutes, I see a few pop up messages for my un-filled required fields and then I see an error message stating "Run-time error '-2147352567 (800200009)': You can't assign a value to this object." When I click on debug, I see the vba editor for a split second before it goes away so I can't tell where in the code it's giving me the error message.

Option Compare Database
Private Sub Form_Timer()
Static OldcontrolName As String
Static OldFormName As String
Static ExpiredTime
Dim ActiveControlName As String
Dim ActiveFormName As String
Dim ExpiredMinutes
Dim msg As String
On Error Resume Next
ActiveControlName = Screen.ActiveControl.Name
ActiveFormName = Screen.ActiveForm.Name
Me.txtActiveForm = ActiveFormName
If (OldcontrolName = "") Or (OldFormName = "") _
    Or (ActiveFormName <> OldFormName) _
    Or (ActiveControlName <> OldcontrolName) Then
    OldcontrolName = ActiveControlName
    OldFormName = ActiveFormName
    ExpiredTime = 0
Else
    ExpiredTime = ExpiredTime + Me.TimerInterval
End If
    ExpiredMinutes = (ExpiredTime / 1000 / 60)
    Me.txtIdleTime = ExpiredMinutes
    
If ExpiredMinutes >= 10 Then
    ExpiredTime = 0
    'msg = "There has been no activity in the last "
    'msg = msg & ExpiredMinutes & " minute(s)! Program will close."
    'MsgBox msg, 48
    'DoCmd.RunCommand acCmdUndo
    If Me.Dirty = True Then
        DoCmd.RunCommand acCmdUndo
        DoCmd.Close
    End If
        Access.Quit
End If
    
End Sub

FYI - I commented out the message box because I just want the program to close completely.

When I test for the idle time shutdown, I am in the Data Entry form on a new record because that's where it's designed to be at all times. In the new record, there are various fields that are required.
I added an acCmdUndo to my idle time code hoping that it will clear the form completely and allow the program to close without any pop up messages, but that is not working.

How can I get the program to close if it's left idle in a new record with un-filled (blank) required fields? FYI - the form is a bound form if that is of any use to my issue.

 

[ranman256]

I too have struggled with this idle time idea.
You dont want the person holding open the app but,
they could have a record open, or partly filled which wont close.

Then you need a timer on every form, so you know when to start/stop the timer.
It became a big hastle, so I dropped it. Those who left their app open, did not get updates, so nyaah.

 

[Leandroarb]

Hi MHamid and ranman256!

I use a code, a module and a macro.
it works perfectly.

Its necessary a form with name: DetectIdleTime
In the event Timer on the form:
(Translate the code coments)

Private Sub Form_Timer()

 ' IDLEMINUTES determina quanto tempo ocioso para esperar antes de
 ' execução da subrotina IdleTimeDetected
   Const IDLEMINUTES = 1 'Define the time to close in minutes


   Static PrevControlName As String
   Static PrevFormName As String
   Static ExpiredTime


   Dim ActiveFormName As String
   Dim ActiveControlName As String
   Dim ExpiredMinutes


   On Error Resume Next


   ' Obter a forma ativa e nome do controle.


   ActiveFormName = Screen.ActiveForm.Name
   If Err Then
      ActiveFormName = "No Active Form"
      Err = 0
   End If


   ActiveControlName = Screen.ActiveControl.Name
      If Err Then
      ActiveControlName = "No Active Control"
      Err = 0
   End If


   ' Anote os nomes atuais ativos e redefinir ExpiredTime se:
   '    1. Eles não foram registrados ainda (código está sendo executado
   '       pela primeira vez).
   '    2. Os nomes anteriores são diferentes do que os atuais
   '       (o usuário tenha feito algo diferente durante o temporizador
   '        intervalo).
   If (PrevControlName = "") Or (PrevFormName = "") _
     Or (ActiveFormName <> PrevFormName) _
     Or (ActiveControlName <> PrevControlName) Then
      PrevControlName = ActiveControlName
      PrevFormName = ActiveFormName
      ExpiredTime = 0
   Else
      ' ...caso contrário, o usuário estava ocioso durante o intervalo de tempo, de modo
      ' incrementar o tempo total expirado.
      ExpiredTime = ExpiredTime + Me.TimerInterval
   End If


   ' O tempo total expirado excede os IDLEMINUTES?
   ExpiredMinutes = (ExpiredTime / 1000) / 60
   If ExpiredMinutes >= IDLEMINUTES Then
      ' ...em caso afirmativo, em seguida, redefinir o tempo expirado a zero...
      ExpiredTime = 0
      ' ...e chamar a sub-rotina IdleTimeDetected.
      IdleTimeDetected ExpiredMinutes
   End If


End Sub

On the module called fncIdleTimeDetected

Sub IdleTimeDetected(ExpiredMinutes)
   Dim Msg As String
   Msg = "Sem usuário ativo detectado," & vbCrLf & "Tempo expirado"
   MsgBox Msg, vbInformation
   'Close the database
   Application.Quit acSaveYes
End Sub

And a macro for open and hide this form.
The code of this macro is:

Function AutoExec()
On Error GoTo AutoExec_Err
DoCmd.OpenForm "DetectIdleTime", acNormal, "", "", acEdit, acHidden
AutoExec_Exit:
Exit Function
AutoExec_Err:
MsgBox Error$
Resume AutoExec_Exit
End Function

Regards

 

[MHamid]

Leandroarb, thank you for your code. I tried it and I'm still getting pop-up messages. My issue is that once the program closes, I get message boxes popping up letting the user know that the required fields were not filled out since that is the coding in the BeforeUpdate event of the data entry form where the program is trying to close. Is there a way I can bypass this using vba code? I tried using the DoCmd.SetWarnings False within the code and I'm still seeing the pop-up messages. Below is the BeforeUpdate event code that triggers when the program is being closed.

Private Sub Form_BeforeUpdate(cancel As Integer)
 
Dim ctl As Access.Control
Dim Msg As String, Style As Integer, Title As String
Dim nl As String

If Me.NewRecord Then
    For Each ctl In Me.Controls
        With ctl
            Select Case .ControlType
                Case acTextBox, acComboBox, acListBox
                    If InStr(ctl.Tag, "*") > 0 And Len(ctl & "") = 0 Then
                        Msg = "Data Required for '" & ctl.Name & "' field!" & nl & _
                        "You can't save this record until this data is provided!" & nl & _
                        "Enter the data and try again . . . "
                        Style = vbCritical + vbOKOnly
                        Title = "Required Data..."
                        MsgBox Msg, Style, Title
                        ctl.SetFocus
                        cancel = True
                    End If
            End Select
        End With
    Next
End If
 
If Me.NewRecord Then
    'Call AuditChanges("txtRefID", "New")
Else
    Call AuditChanges("txtRefID", "Edit")
End If
End Sub

 

[MHamid]

FYI - I got my code to work with my issue when closing the form with required fields.
I am using the code below and it works exactly like I need it (this is without a message box)

Option Compare Database
Private Sub Form_Timer()

Static OldcontrolName As String
Static OldFormName As String
Static ExpiredTime

Dim ActiveControlName As String
Dim ActiveFormName As String
Dim ExpiredMinutes
Dim msg As String
Dim from As Form
Dim intLoop As Integer
 
On Error Resume Next
ActiveControlName = Screen.ActiveControl.Name
ActiveFormName = Screen.ActiveForm.Name
Me.txtActiveForm = ActiveFormName
If (OldcontrolName = "") Or (OldFormName = "") _
    Or (ActiveFormName <> OldFormName) _
    Or (ActiveControlName <> OldcontrolName) Then
    OldcontrolName = ActiveControlName
    OldFormName = ActiveFormName
    ExpiredTime = 0
Else
    ExpiredTime = ExpiredTime + Me.TimerInterval
End If
    ExpiredMinutes = (ExpiredTime / 1000 / 60)
    Me.txtIdleTime = ExpiredMinutes
    
If ExpiredMinutes >= 10 Then
    ExpiredTime = 0
    For intLoop = Form.Count - 1 To 0 Step -1
        Set frm = Forms(intLoop)
        frm.Undo
        DoCmd.Close acForm, frm.Name
    Next
    Application.Quit acSaveNo
End If
    
End Sub