Public Function CheckStatus()
' Use this in the OnOpen Event of your main form, switchboard form, etc ... or in the Main sub that runs whenever your user first open their Front End
Dim blnUnderDev As Boolean
Dim rst As DAO.Recordset
On Error GoTo ERR_HANDLER
10: Set rst = CurrentDb.OpenRecordset("tblDev") 'Lookup table
20: With rst
30: .FindFirst "[ID] = 1"
40: blnUnderDev = ![UnderDev] 'True if I have set the flag
50: .Close
60: End With
70: Set rst = Nothing
80: If blnUnderDev = True Then
90: MsgBox "The Database is currently down for modification or repair", vbOKOnly, "Administrator Message"
100: Application.Quit
110: Else
'Continue
120: End If
130: Exit Function
ERR_HANDLER:
140: SendError "#" & Err.Number & ": " & Err.Description, "CheckStatus", CStr(Erl)
End Function
Public Function CheckStatusOpen()
'This code fires at the OnTimer event of a hidden form that opens when the program starts and stays open in the background
Dim blnUnderDev As Boolean
10: blnUnderDev = DLookup("[UnderDev]", "tblDev", "[ID] = 1")
20: If blnUnderDev = True Then
'Open a borderless message form with a 30 second timer that informs the user that updates need to be made and warns of a shutdown in 30 sec
30: DoCmd.openForm "frmAdminMsg"
40: End If
End Function
Public Function getOut()
'This code fires at the OnTimer event of my "frmAdminMsg" form
On Error Resume Next
10: DoCmd.Close acForm, "frmHidden"
20: DoCmd.Close acForm, "frmAdminMsg"
30: Application.Quit
40: Exit Function
ERR_HANDLER:
50: SendError "#" & Err.Number & ": " & Err.Description, "getOut", CStr(Erl)
End Function
Public Function modify()
'This code goes in my development database and I run it when I need to make updates
Dim strLdbName As String
On Error GoTo ERR_HANDLER
10: strLdbName = "Z" 'Put the pathname to your locking file here instead of "Z"
20: CurrentDb.Execute "UPDATE tblDev SET tblDev.UnderDev = True WHERE (((tblDev.ID)=1))" 'Set my development flag in the lookup table which is a linked table in my development databse - the lookup table resides in the BackEnd database
'This loop runs until the locking file is gone, indicating all users are out of the backend
30: Do
40: strTest = Dir(strLdbName, vbHidden)
50: DoEvents
60: Loop Until strTest = ""
70: Sleep 6000 'I had to put this here as a delay. I was having some problems with doing updates immediately - don't quite know why
'Insert code to do your updates here
'Reset the development flag in the lookup table to "off", allowing users to open the FrontEnd again
80: CurrentDb.Execute "UPDATE tblDev SET tblDev.UnderDev = False WHERE (((tblDev.ID)=1))"
90: Exit Function
ERR_HANDLER:
100: SendError "#" & Err.Number & ": " & Err.Description, "Modify", CStr(Erl)
End Function
