Shared Access Database Management

Here is a handy setup for those who need to manage a shared access database.

Either you can create this from scratch as per the example or add the new tables
to your existing database.

This setup will track:

1. the users currently using the database
2. what time the user and computer name currently logged in.
3. what version of the database the user is currently using.
4. allow the shutdown of a user’s database at your (the database manager) discretion.

Items 1-3

This screenshot will show the users currently in the database and the minutes they have been logged in.

In the backend database we are going to have a table called “tblSystemSecurityUsers” which will hold this information (see image above).

We will be linking to it from our front end databases all the users will use.

This is the code behind “frmWelcome”. This form will launch when the database starts up.

Option Compare Database

Private Sub btnClose_Click()
    CloseDatabase

End Sub

Private Sub Form_Close()
    CloseDatabase
End Sub

Private Sub Form_Open(Cancel As Integer)
    'update the shared table with the login
    
    Dim dblVersion As Double
    Dim rst As Recordset
    
    dblVersion = DLookup("DBVersion", "tblVersion")
        
    'IMPORTANT: Both linked and local tables can use the FindFirst methon, if you specify _
        dbOpenDynaset on the second argument above.

    Set rst = CurrentDb.OpenRecordset("tblSystemSecurityUsers", dbOpenDynaset)
    
    'find the manually entered user you are tracking
    rst.FindFirst "LoginName='" & Environ("Username") & "'"

    rst.Edit
    
    rst.Fields("LoginName") = Environ("UserName")
    rst.Fields("LoginComputerName") = Environ("ComputerName")
    rst.Fields("LoggedIn") = True
    rst.Fields("LoginTime") = Now()
    rst.Fields("LoggedInVersion") = dblVersion
    
    rst.Update
    
    rst.Close
    Set rst = Nothing
    
    
    'update the current form with currently logged in users
    CurrentDb.Execute ("DELETE * FROM tblSystemSecurityUsers_Local")
    
    DoCmd.SetWarnings False
    DoCmd.OpenQuery ("qrySystemSecurityUsers_APPEND")
    DoCmd.SetWarnings True
    
    Me.lstOnline.Requery

End Sub

Private Sub Form_Timer()
    Me.lblTime.Caption = Now()
    
    'update the current form with currently logged in users
    CurrentDb.Execute ("DELETE * FROM tblSystemSecurityUsers_Local")
    
    DoCmd.SetWarnings False
    DoCmd.OpenQuery ("qrySystemSecurityUsers_APPEND")
    DoCmd.SetWarnings True
    
    Me.lstOnline.Requery
    
    DoEvents
    
    ' if file exists then shutdown db
    If ShutdownFile = True Then
        CloseDatabase
    End If
    
End Sub

Use the form’s properties to set the timer:

Item 4

Notice the “If ShutdownFile=True … ”

If the “shutdown.txt” file exists in a specified directory, that user’s front end will shut down.

Here is the code:

Public Function ShutdownFile() As Boolean
    
    Dim blnTemp As Boolean
    
    Dim objFSO As Object
    Dim strFileName As String
    
    'make this a path on your network
    strFileName = CurrentProject.Path & "\shutdown.txt"
    

    Set objFSO = CreateObject("Scripting.FileSystemObject")
    If (objFSO.FileExists(strFileName)) Then

        'MsgBox "The database requires a shutdown now. The database will be closed.", vbInformation, APP_NAME
    
        blnTemp = True
    Else
        blnTemp = False
    End If
    
    Set objFSO = Nothing
        
    ShutdownFile = blnTemp
    
End Function

This code runs on the timer event of the form, and checks for the existence of the “shutdown.txt” file.

…and here is the shutdown process:

Public Sub CloseDatabase()
    
    Dim rst As Recordset
    
    Set rst = CurrentDb.OpenRecordset("tblSystemSecurityUsers", dbOpenDynaset)
    
    'IMPORTANT: Both linked and local tables can use the FindFirst methon, if you specify _
        dbOpenDynaset on the second argument above.
         
    rst.FindFirst "LoginName='" & Environ("Username") & "'"

    rst.Edit
    
    rst.Fields("LoggedIn") = False
    rst.Fields("LogOffTime") = Now()
    
    rst.Update
    
    rst.Close
    Set rst = Nothing
    
    Application.Quit acQuitSaveNone
End Sub

Perhaps you can “morph” this to use it in your own unique way.

Here are the database files:

SharedAccessDatabase.accdb

SharedAccessDatabase_BE.accdb

Let me know if you have any questions.

By the way, if you got or are getting value from the VBA information, please click the "Donate" button to give me a small token of your appreciation, thanks!