Follow along with the video below to see how to install our site as a web app on your home screen.
Note: This feature may not be available in some browsers.
Private Sub Form_Load()
AutoExec
End Sub
Private Sub Form_Timer()
Me.TimerInterval = 0
MaintenanceCheck
End Sub
Form_Switchboard.TimerInterval = 3000
Function MaintenanceCheck()
'--------------------------------------
'- This function checks to see if the -
'- user is the first to log in today. -
'- It triggers a Compact and repair -
'- process if this is true -
'--------------------------------------
On Local Error GoTo MCError1
Dim stDatabaseName As String
Dim stLastCompacted As String
Dim stMessage As String
Dim stSQl As String
Dim stTimeNow As String
Dim stToday As String
stToday = Format$(Now, "yyyymmdd") 'Note the yyyymmdd format
stLastCompacted = DLookup("[ParameterValue]", "tblControl1", "[ParameterName] = 'LastCompacted'")
stDatabaseName = DLookup("[ParameterValue]", "tblControl1", "[ParameterName] = 'DatabaseName'")
'--------------------------------------
'- Database already compacted today -
'--------------------------------------
If stLastCompacted >= stToday Then
Exit Function
End If
'--------------------------------------
'- Database compact process is -
'- required. Display message -
'--------------------------------------
stMessage = "You are the first person to use this database today." & vbCrLf & vbCrLf
If intSecurityLevel = 1 Then
stMessage = stMessage & "Please ask someone with Data-entry or Administrator permissions "
stMessage = stMessage & "to log in and run start of day maintenance."
MsgBox stMessage, vbInformation, stDatabaseName
Exit Function
Else
stMessage = stMessage & "When you click [OK], start of day maintenance will take place." & vbCrLf & "Please wait ..."
MsgBox stMessage, vbInformation, stDatabaseName
stMessage = SysCmd(acSysCmdSetStatus, "Daily Maintenance In Progress ... Please Wait")
End If
'---------------------------------------
'- Write a log record -
'---------------------------------------
stMessage = WriteLogRecord("CompactDatabase", "MaintenanceCheck", "")
'---------------------------------------
'- Update the Control Table record -
'---------------------------------------
stSQl = "UPDATE tblControl1 SET [tblControl1].[ParameterValue] = '" & stToday & "' WHERE [tblControl1].[ParameterName] = 'LastCompacted'"
DoCmd.SetWarnings (False)
DoCmd.RunSQL (stSQl)
DoCmd.SetWarnings (True)
'---------------------------------------
'- Call the CompactDatabase function. -
'- This must be the last line of code -
'- in the MaintenanceCheck function -
'---------------------------------------
CompactDatabase
Exit Function
MCError1:
MsgBox CStr(Err) & " - " & Error$
Resume MCEnd
MCEnd:
End Function
'------------------------------------
'- Compact the database. This only -
'- works if it is the only code in -
'- the function, and if the -
'- function is called from the last -
'- line of another VB function -
'------------------------------------
CommandBars("Menu Bar"). _
Controls("Tools"). _
Controls("Database utilities"). _
Controls("Compact and repair database..."). _
accDoDefaultAction
End Function