kicking people out of a frontend (1 Viewer)

stuartam

Registered User.
Local time
Today, 04:11
Joined
Jul 16, 2004
Messages
93
Hi, after reading the forums i have managed to kick people out of my front end using the code below in the 'on time' event of a form:

Code:
Private Sub Form_Timer()
    Dim rs As ADODB.Recordset
    Set rs = New ADODB.Recordset
    Dim strSQL As String
    rs.Open "tblLogout", CurrentProject.Connection, adOpenKeyset, adLockOptimistic
    rs.MoveFirst
    If rs!Logout = True Then
    MsgBox "DB update, You are Kicked ;-)"
    do cmd.quit
    End
    End If
    rs.Close
    Set rs = Nothing
End Sub

but i want it to give the user a warning 15 minutes before the update and i thourght about using the above again but getting it too look at another field of the table.

so when i change 'Logout' to true on the table they get a logout warning asking them to exit within 15 minutes, and then after 15 minutes set the 'kick' field of the table to true which will give them a msg box telling them that they are being kicked out of the DB and then exiting the front end for them :D

any ideas?

best regards
 

WayneRyan

AWF VIP
Local time
Today, 04:11
Joined
Nov 19, 2002
Messages
7,122
Stuart,

Change your flag to the Date/Time that the database will close.

Code:
Private Sub Form_Timer()
    Dim rs As ADODB.Recordset
    Set rs = New ADODB.Recordset
    Dim lngMinutesToLogout As Long

    Dim strSQL As String
    rs.Open "tblLogout", CurrentProject.Connection, adOpenKeyset, adLockOptimistic
    rs.MoveFirst
    If IsNull(rs!LogoutTime) Then
       rs.Close
       Set rs = Nothing
       Exit Sub
    Else
       lngMinutesToLogout = DateDiff("m", Now(), rs!LogoutTime)
       If lngMinutesToLogout > 1 Then
          MsgBox("Database will be unavailable in " & lngMinutesToLogout & " minutes.")
          rs.Close
          Set rs = Nothing
          Exit Sub
       Else
          MsgBox "DB update, You are Kicked ;-)"
          rs.Close
          Set rs = Nothing
          DoCmd.Quit
       End If
    End If
End Sub

I'm redoing my computer, don't have Office installed yet, not sure about the order
of the arguments in DateDiff, but that's the general idea.

Wayne
 

stuartam

Registered User.
Local time
Today, 04:11
Joined
Jul 16, 2004
Messages
93
thanks for the help i will give it a go when i have woken up propperly :D

thanks again
 

stuartam

Registered User.
Local time
Today, 04:11
Joined
Jul 16, 2004
Messages
93
hi i couldent get it to work but i have been messing and come up with this that sort of works:

Code:
Option Compare Database
Public Function updwrng()
    Dim rs As ADODB.Recordset
    Set rs = New ADODB.Recordset
    Dim strSQL As String
    rs.Open "tblLogout", CurrentProject.Connection, adOpenKeyset, adLockOptimistic
    rs.MoveFirst
    If rs!Logout = True Then
    Dim sdtime As String
    sdtime = DateAdd("n", 15, Time())
    MsgBox "There will be an update of the Validation Database 15 minutes" & vbCrLf & "Please finish what you are doing and exit before " & sdtime & vbCrLf & "If you have not exited by then you will be kicked out"
    Call kick
    End If
    rs.Close
    Set rs = Nothing
End Function

Public Function kick()
    Dim rs As ADODB.Recordset
    Set rs = New ADODB.Recordset
    Dim strSQL As String
    rs.Open "tblLogout", CurrentProject.Connection, adOpenKeyset, adLockOptimistic
    rs.MoveFirst
    If rs!kick = True Then
    MsgBox "kick kick"
    End If
    rs.Close
    Set rs = Nothing
End Function

its a module so i can use it in several forms, but the one problem i have is that once it has has a true from 'Logout' i want it to stop using that if and only use the if statement in the 2nd finction ( kick ) sort of like a show once.

at the moment as soon as 'Logout' is true it shows the msg box and when you click ok it will show it again after the given time period in the time interval of the form.
now when 'logout' & 'kick' are true it shows the logout msg and when you press ok it then shows the kick msg and when you click ok it then shows the logout msg again.

does all that make sence

any ideas?

best regards
 

stuartam

Registered User.
Local time
Today, 04:11
Joined
Jul 16, 2004
Messages
93
this is driving me nuts

Hi,

i am slowly loosing all my hair ( and im only 24 :confused: )

i have this bit of code:

Code:
Public Function updwrng(x As Integer)
    Dim rs As ADODB.Recordset
    Set rs = New ADODB.Recordset
    Dim strSQL As String
    rs.Open "tblLogout", CurrentProject.Connection, adOpenKeyset, adLockOptimistic
    rs.MoveFirst
    if (rs!Logout = True And x = 1) then
        x = x - 1
        Dim sdtime As String
        sdtime = DateAdd("n", 15, Time())
        MsgBox "There will be an update of the Validation Database 15 minutes" & vbCrLf & "Please finish what you are doing and exit before " & sdtime & vbCrLf & "If you have not exited by then you will be kicked out" & vbCrLf & " x = " & x
    end if
    rs.Close
    Set rs = Nothing
    Call Kick
End Function

what i want it to do is when Logout = True And x = 1 to run the if statement once ( thats why the x = x - 1, so that the next time its 0 ) and then eventually run a different module, but it just keeps running and its driving me nuts.

what am i doing wrong, please help i dont want to end up like homer ;)

best regards
 

Travis

Registered User.
Local time
Yesterday, 20:11
Joined
Dec 17, 1999
Messages
1,332
First Save yourself some frustration add a global Boolean to your module.

Example:

Code:
Dim mfAlreadyToldYou as Boolean

Public Function updwrng()
    Dim rs As ADODB.Recordset
    Set rs = New ADODB.Recordset
    Dim strSQL As String
    rs.Open "tblLogout", CurrentProject.Connection, adOpenKeyset, adLockOptimistic
    rs.MoveFirst
    if (rs!Logout = True And mfAlreadyToldYou  = False) then
        mfAlreadyToldYou = True
        Dim sdtime As String
        sdtime = DateAdd("n", 15, Time())
        MsgBox "There will be an update of the Validation Database 15 minutes" & vbCrLf & "Please finish what you are doing and exit before " & sdtime & vbCrLf & "If you have not exited by then you will be kicked out" & vbCrLf & " x = " & x
    end if
    rs.Close
    Set rs = Nothing
    Call Kick
End Function

Public Function kick()
    Dim rs As ADODB.Recordset
    Set rs = New ADODB.Recordset
    Dim strSQL As String
    rs.Open "tblLogout", CurrentProject.Connection, adOpenKeyset, adLockOptimistic
    rs.MoveFirst
    If rs!kick = True Then
    MsgBox "kick kick"
    End If
    rs.Close
    Set rs = Nothing
End Function


I also suggest not using MsgBoxes but create a Dialog form with a Timer on it. The reason is that Msgboxes will prevent the rest of the code from running while it sits looking pretty on the screen. The Dialog form (made to look like a msgbox) with the timer will close itself after your designated time frame. This will keep you from having to hunt down the user that opened the database and then went to lunch/meeting/home for the weekend. :D
 

stuartam

Registered User.
Local time
Today, 04:11
Joined
Jul 16, 2004
Messages
93
thanks for the reply i will give it ago, what you recomend does make more sence than the way im currently doing it.

regards
 

Jordan2000

Registered User.
Local time
Today, 05:11
Joined
Nov 4, 2004
Messages
24
Do you have a working example ?? in Access 97 ?
And can you share it ?
 

Users who are viewing this thread

Top Bottom