Remote shutdown of a shared DB... (1 Viewer)

[bikeman77]

Hi All:
I have a multi-user database that is split into FE/BE. In order to perform certain tasks in the database, I need to have exclusive access to it. So, I either have to go around and close the DB myself or call the users to ask them to exit. I found this on the Microsoft Knowledge base...Remote App Shutdown

The code line that i think is the problem is the red...

Private Sub Form_Timer()
On Error GoTo Err_Form_Timer
[COLOR=Red]    Dim strFileName As String
    strFileName = Dir("\\Server\Users\CCA_CCS_TestingDatabase\MyData\chkfile.ozx")[/COLOR]
    If boolCountDown = False Then
        ' Do nothing unless the check file is missing.
        If strFileName <> "chkfile.ozx" Then
            ' The check file is not found so
            ' set the count down variable to true and
            ' number of minutes until this session
            ' of Access will be shut down.
            boolCountDown = True
            intCountDownMinutes = 2
        End If
    Else
        ' Count down variable is true so warn
        ' the user that the application will be shut down
        ' in X number of minutes.  The number of minutes
        ' will be 1 less than the initial value of the
        ' intCountDownMinutes variable because the form timer
        ' event is set to fire every 60 seconds
        intCountDownMinutes = intCountDownMinutes - 1
        DoCmd.OpenForm "frmAppShutDownWarn"
        Forms!frmAppShutDownWarn!txtWarning = "The database will be shut down in approximately " & intCountDownMinutes & " minute.  Please save all work."
        If intCountDownMinutes < 1 Then
            ' Shut down Access if the countdown is zero,
            ' saving all work by default.
            Application.Quit acQuitSaveAll
        End If
    End If

Exit_Form_Timer:
    Exit Sub

Err_Form_Timer:
    Resume Next
End Sub

However, I don't think that the code is able to access the network because it acts as if the file for which it is checking isn't there or named incorrectly because it shuts the application down regardless of whether or not the file is named correctly. Otherwise, it works perfectly.

Do you think or know that the app can't access our server? I am stumped on this one.

Thanks in advance for any suggestions.

B

 

[Uncle Gizmo]

Change this line >>>

strFileName = Dir("\\Server\Users\CCA_CCS_TestingDatabase\MyData\chkfile.ozx")

to:

strFileName = "chkfile.ozx"

Does it work?

If it does then you are either not getting through to the server or the "Dir" function is not working correctly.

Which version of access are you using?

 

[bikeman77]

Oh, sorry. That/those space(s) was/were a typo when I was formatting the color for the board.

I am using Access 2000. I even copied the database and followed the instructions to the letter to see if it would work. It still shuts the application down regardless of the file name.

Thanks so much for your help with this.

 

[Uncle Gizmo]

I asked "Which version of access are you using?" because that example at MS site:

APPLIES TO
• Microsoft Office Access 2003
• Microsoft Access 2002 Standard Edition

You need to find out why they don't show A2K as well. I suspect this line:

>>> strFileName = Dir("\\Server <<<

Unless you have a function Dir I would guess that it is built in to A2002 and up.....

 

[bikeman77]

my fault...

Thanks for the revelation Gizmo. I didn't even pay any attention to that. I was just so thrilled to have an application like that! Sorry for the trouble over my lack of attention to detail.

Thanks a lot again.

 

[modest]

I did not know it was possible to do a remote shutdown. hmm interesting stuff =)!!!

 

[ghudson]

How to Detect User Idle Time or Inactivity

I use the code from that link with a form open in the hidden view so that user never sees it. Then I place this code in the hidden form to close the db if there is not activity. To reset the idle time I reopen the hidden form when and where needed. I also have a value stored in a table that I change to Yes or No if I need to immediately close the user's front end.

'this is how to open a form as hidden
DoCmd.OpenForm "YourFormName", , , , , acHidden

Option Compare Database
Option Explicit
    
Private Sub Form_Timer()
    
    Dim ExpiredMinutes
    
    Static ExpiredTime
    
    ' IDLEMINUTES determines how much idle time to wait for before running the IdleTimeDetected subroutine.
    Const IdleMinutes = 1 'Minutes
    
    ' Increment the total expired time.
    ExpiredTime = ExpiredTime + Me.TimerInterval
    
    ' Does the total expired time exceed the IDLEMINUTES?
    ExpiredMinutes = (ExpiredTime / 1000) / 60
    If ExpiredMinutes >= IdleMinutes Then
       ' ...if so, then reset the expired time to zero...
       ExpiredTime = 0
       ' ...and call the IdleTimeDetected subroutine.
       IdleTimeDetected ExpiredMinutes
    End If
    
End Sub

Private Function IdleTimeDetected(ExpiredMinutes)
   
'   MsgBox "No user activity detected in the last " & ExpiredMinutes & " minute(s)!", vbInformation, "Idle User"
   Application.Quit acQuitSaveNone
   
End Function

Private Sub Form_Open(Cancel As Integer)
            
    Static ExpiredTime
            
    ExpiredTime = 0
    
End Sub

 

[Uncle Gizmo]

Sorry for the trouble over my lack of attention to detail.

It is usually me that suffers from a lack of attention to detail! It is gratifying to see that someone else can make the odd mistake as well!

 

[bikeman77]

That is great ghudson! That works like a champ. I appreciate your help.

 

[bikeman77]

What I finally ended up with was a form with a label stating that the database will shut down in x minutes. This form opens with the IdleTimeDetected(ExpiredMinutes) procedure. The form's Ontimer Event is set to shut the database down in however many seconds I choose. This way the user doesn't have to provide input in the form of a click-- the reason for this being that my users will leave the database open for hours on end and I don't want to have to walk a mile just to shut the database down.

Code:

Private Sub Form_Timer()
' IDLEMINUTES determines how much idle time to wait for before
         ' running the IdleTimeDetected subroutine.
         Const IdleMinutes = 90

         Static PrevControlName As String
         Static PrevFormName As String
         Static ExpiredTime

         Dim ActiveFormName As String
         Dim ActiveControlName As String
         Dim ExpiredMinutes

         On Error Resume Next

         ' Get the active form and control name.

         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

         ' Record the current active names and reset ExpiredTime if:
         '    1. They have not been recorded yet (code is running
         '       for the first time).
         '    2. The previous names are different than the current ones
         '       (the user has done something different during the timer
         '        interval).
         If (PrevControlName = "") Or (PrevFormName = "") Or (ActiveFormName <> PrevFormName) Or (ActiveControlName <> PrevControlName) Then
            PrevControlName = ActiveControlName
            PrevFormName = ActiveFormName
            ExpiredTime = 0
         Else
            ' ...otherwise the user was idle during the time interval, so
            ' increment the total expired time.
            ExpiredTime = ExpiredTime + Me.TimerInterval
         End If

         ' Does the total expired time exceed the IDLEMINUTES?
         ExpiredMinutes = (ExpiredTime / 1000) / 60
         If ExpiredMinutes >= IdleMinutes Then
            ' ...if so, then reset the expired time to zero...
            ExpiredTime = 0
            ' ...and call the IdleTimeDetected subroutine.
            IdleTimeDetected ExpiredMinutes
         End If
      End Sub
      
Sub IdleTimeDetected(ExpiredMinutes)
    DoCmd.OpenForm "frmDatabaseInactiveMsg", acNormal, , , acFormReadOnly, acWindowNormal
End Sub

Thanks everyone for the help.

 

[ghudson]

There is code that you can use to call a message box that will disapear after x number of seconds. I use the below code to do just that when I give the users a warning message that the application will shut down in 30 seconds. If the user clicks the OK button then the db shuts down right away, otherwise the message box will auto close in 30 seconds and then the db will shut down. It is nice to at least warn the users in the db with a message since you do not know which form they are in.

'Put this at the top of a public module [not a form module]

'Used with a timed message box
Public Property Get oMsgBox() As Object
    Set oMsgBox = CreateObject("WScript.Shell")
End Property

'Put this in your routine to force close the application

[COLOR=Green]    'oMsgBox.PopUp "Testing...closing in ten seconds.", [COLOR=Blue]10[/COLOR], "Force Closed", vbInformation[/COLOR]
    oMsgBox.PopUp "Your copy of the XXXX program will be closed in thirty seconds.  The data tables in the XXXX program are being updated or the XXXX program is being taken off line for maintenance.  You may try to open the XXXX program again in twenty minutes." & vbCrLf & vbLf & "Please contact XXXX if you continue to have problems opening the XXXX program.", 30, "Force Closed", vbInformation
    DoCmd.RunCommand acCmdExit

 

[bikeman77]

Thanks a lot for that. That's pretty neat. However, I may still use my little form with the label displaying the shutdown message. I am not sure how to create a timed message box. I would like to have it so that if the user clicks a button on the message box like "Continue", for example, the database does not shut down-- maybe resets the timer or something. Could that be done?

Thanks so much for the advice.

 

[mdjks]

This really helped me. Thank you all

 

[skea]

ghudson, good we never lost your self closing message boxes.
I wonder how do you treat it with a timer event!!

 

[ghudson]

ghudson, good we never lost your self closing message boxes.
I wonder how do you treat it with a timer event!!

What do you mean "with a time event"?

 

[skea]

Thanks ghudson,
i found this could be better than using the two form method of doing this because the message bos displays right in the face of the user even if the access app is minimised.
Now from your usual link, whis is now gone. What i mean is in red

When ever I need a timed message box. That code snipet is from a routine I have that shuts down the front end of a users db when I need to kick everybody out. I have a hidden form with a timer that checks the value of a linked table. If the value = true then the user will get the timed message box alerting them that the db is shutting down in 30 seconds.

It works great as long as I do not try to give it a time greater than 40 seconds. I also use it in a db that verifies if a specific file exists, if not, the user is not authorized to open the db and I shut it down. That db.mde is not secured and I want to ensure the employees do not try to take the db home.

To be more clear. I want the timer event to check every after some time if the value in the table has been changed, if yes then it fires up the timed message, if not(I dont know whether we can be able to close the timed message and popup a new one saying "the procedure has been cancelled, You can Gon On with Your Work")

 

[ghudson]

Here is the timer code I use in my form that is hidden. It checks to see if the users front end needs to be closed.

Private Sub Form_Timer()
On Error GoTo Err_Form_Timer

    Dim ExpiredMinutes
    
    Static ExpiredTime
    
    ' IDLEMINUTES determines how much idle time to wait for before running the IdleTimeDetected subroutine.
    Const IdleMinutes = 60 'Minutes
    
    ' Increment the total expired time.
    ExpiredTime = ExpiredTime + Me.TimerInterval
    
    ' Does the total expired time exceed the IDLEMINUTES?
    ExpiredMinutes = (ExpiredTime / 1000) / 60
    If ExpiredMinutes >= IdleMinutes Then
       ' ...if so, then reset the expired time to zero...
       ExpiredTime = 0
       ' ...and call the IdleTimeDetected subroutine.
       IdleTimeDetected ExpiredMinutes
    End If
    
    Call ForceCloseAllOpenUsers
    
Exit_Form_Timer:
    Exit Sub

Err_Form_Timer:
    MsgBox Err.Number & " - " & Err.Description
    Resume Exit_Form_Timer
    
End Sub

Private Function IdleTimeDetected(ExpiredMinutes)
On Error GoTo Err_IdleTimeDetected
   
'   MsgBox "No user activity detected in the last " & ExpiredMinutes & " minute(s)!", vbInformation, "Idle User"
    If CurrentUser <> "programmer" Then
       Application.Quit acQuitSaveNone
    Else
        'MsgBox "IdleTimeDetected expired but you logged in as the programmer so the db will not close."
    End If
   
Exit_IdleTimeDetected:
    Exit Function

Err_IdleTimeDetected:
    MsgBox Err.Number & " - " & Err.Description
    Resume Exit_IdleTimeDetected
   
End Function

 

[skea]

Thanks ghudson,
but i thought that one will just detect IdleUsers then shut their FE down. Or may be iam missing your "Call ForceCloseAllOpenUsers".
i Meant something like this below. Still jamming though.

Option Compare Database
Option Explicit
Public oMsgBox As Object
Dim intCountdown As Integer

Private Sub Form_Load()
 intCountdown = 10
End Sub

Public Function PopUpMsgBox(strMessage As String, Optional lSec As Long = 2, Optional strTitle As String = "Microsoft Access", Optional strButtons As VbMsgBoxStyle = vbOKOnly)
Set oMsgBox = CreateObject("WScript.Shell")
oMsgBox.PopUp strMessage, lSec, strTitle, strButtons
Set oMsgBox = Nothing
End Function

Private Sub Form_Timer()
    Dim strMsg As String
    intCountdown = intCountdown - 1
    If intCountdown <= 0 Then
    Set oMsgBox = Nothing
    Application.Quit
    End If
    
    If DLookup("[LogOutFlag]", "tblLogOutMantainence", "[LogOutFlag]=true") Then
    PopUpMsgBox "Automatically Log Them Out in 5 Seconds", 5
        
    ElseIf DLookup("[LogOutFlag]", "tblLogOutMantainence", "[LogOutFlag]=false") Then
      PopUpMsgBox " Mantainence Cancelledxxxxxx Continue Doing Your Work xxxxxxxxxxx ! ", , "NoClose", vbCritical

    End If
      
End Sub

 

[ghudson]

There is a lot more to this process. Forgive me but it has been a long time since I had to touch it. There is proabably more in here than the average joe would need but this should give you an idea of how I force close my users.

I have a table named tForceClose and it has three fields; RecordID [text], ForceClose [Yes/No], ImportersComputerName [Text]

I run this functon to manually set the force close "switch" to yes...

Public Function ForceCloseOpenUsersYesNo()
On Error GoTo Err_ForceCloseOpenUsersYesNo
    
    If MsgBox("Do you want to force close all the current users of the " & gcProgram & " program so that you can import the latest data and update the program?", vbQuestion + vbYesNo, "Force Close Users") = vbYes Then
        DoCmd.SetWarnings False
            DoCmd.RunSQL ("UPDATE tForceClose SET tForceClose.ForceClose = -1, tForceClose.ImportersComputerName = Environ('ComputerName') WHERE (((tForceClose.RecordID)='1'));")
        DoCmd.SetWarnings True
        MsgBox "All current users will be forced out of their " & gcProgram & " program and their opened " & gcProgram & " program will close in 60 seconds.  Other users will not be able to open the " & gcProgram & " program while you have the ''Force Closed'' function active." & vbCrLf & vbLf & "You must wait at least 60 seconds before you attempt to import any data files.", vbInformation, "Force Close Activated"
    Else 'user clicked No
        DoCmd.SetWarnings False
            DoCmd.RunSQL ("UPDATE tForceClose SET tForceClose.ForceClose = 0, tForceClose.ImportersComputerName = Environ('ComputerName') WHERE (((tForceClose.RecordID)='1'));")
        DoCmd.SetWarnings True
        MsgBox "All current users will not be forced out of their " & gcProgram & " program and the other users will be able to open the " & gcProgram & " program.", vbInformation, "Force Close Deactivated"
    End If
    
Exit_ForceCloseOpenUsersYesNo:
    Exit Function
    
Err_ForceCloseOpenUsersYesNo:
    MsgBox Err.Number & " - " & Err.Description
    Resume Exit_ForceCloseOpenUsersYesNo

End Function

Here is the code I use in the ForceCloseAllOpenUsers() function

Public Function ForceCloseAllOpenUsers()
On Error GoTo Err_ForceCloseAllOpenUsers
    
    If DLookup("[ForceClose]", "tForceClose", "[RecordID] = " & "'1'") = -1 And CurrentUser = "programmer" Then
        If MsgBox("You have logged into the " & gcProgram & " program as user 'programmer' and the Force Close parameter is set to close all users." & vbCrLf & vbLf & "Do you want to reset the ''force close all current users'' parameter?", vbQuestion + vbYesNo, "Reset Force Close Users") = vbYes Then
            Call ForceCloseOpenUsersYesNo
            Exit Function
        End If
    End If
    
    If DLookup("[ForceClose]", "tForceClose", "[RecordID] = " & "'1'") = -1 Then
        'MsgBox "Force Close = True"
            'MsgBox DLookup("[ImportersComputerName]", "tForceClose", "[RecordID] = " & "'1'")
            'MsgBox Environ("ComputerName")
            If DLookup("[ImportersComputerName]", "tForceClose", "[RecordID] = " & "'1'") <> Environ("ComputerName") Then
                'MsgBox "Force Close = True, " & "ComputerNames do not = "
                Beep
                oMsgBox.PopUp "Your copy of the " & gcProgram & " program will be closed in ten seconds.  The data tables in the " & gcProgram & " program are being updated or the " & gcProgram & " program is being taken off line for maintenance.  You may try to open the " & gcProgram & " program again in twenty minutes." & vbCrLf & vbLf & "Please contact your mommy if you continue to have problems opening the " & gcProgram & " program.", 10, "Force Closed", vbInformation
                DoCmd.RunCommand acCmdExit
                'MsgBox "'Force Close' detected but you logged in as programmer so the db will not close."
            Else
                'MsgBox "Force Close = True, " & "ComputerName do ="
            End If
    Else
        'MsgBox "'Force Close' not detected."
    End If
    
Exit_ForceCloseAllOpenUsers:
    Exit Function
    
Err_ForceCloseAllOpenUsers:
    MsgBox Err.Number & " - " & Err.Description
    Resume Exit_ForceCloseAllOpenUsers

End Function

 

[skea]

Thanks Big Boy