Have you ever had one of those users that open the database, does other things, comes back and opens another instance, … and so it goes.

Maybe it’s time to minimize the issues this can cause by limiting a user to only being able to launch a single instance of a given database.
 

Using Your Launching Script

If you’ve setup your users properly and they have their own private copy of the database front-end, then the easiest technique to stop them from initiating multiple instances of your database maybe be through the launch script.

A simple VBScript to launch a Microsoft Access database may look something like:

Option Explicit
Dim oAccess

' Create Access Application object
Set oAccess = CreateObject("Access.Application")

' Make Access visible
oAccess.Visible = True
oAccess.UserControl = True

' Open the database
oAccess.OpenCurrentDatabase "C:\Databases\Demos\OnlyLaunchOnce.accdb"

' Cleanup
Set oAccess = Nothing

Now, if we wanted to stop another instance of that database from being launch, the simplest solution would be to first check for the existence of an Access lock file (ldb, laccdb) and would modify the above to be more like:

Option Explicit
Dim oFSO, oAccess, dbPath, laccdbPath

' Set the path to your Access database file
dbPath = "C:\Databases\Demos\OnlyLaunchOnce.accdb"

' Construct the path for the .laccdb lock file
laccdbPath = Replace(dbPath, ".accdb", ".laccdb")

' Create FileSystemObject
Set oFSO= CreateObject("Scripting.FileSystemObject")

' Check if .laccdb file exists
If oFSO.FileExists(laccdbPath) Then
    WScript.Echo "The database is already runnings."
Else
    ' Create Access Application object
    Set oAccess = CreateObject("Access.Application")
    
    ' Make Access visible
    oAccess.Visible = True
    oAccess.UserControl = True

    ' Open the database
    oAccess.OpenCurrentDatabase dbPath
End If

' Cleanup
Set oFSO = Nothing
Set oAccess = Nothing

 

Using Code From Within Your Database

Checking the Application Window Title

Another way of handling this could be to validate that when launched the same window title is found in the list of opened application windows. For this, we need to turn towards using a couple Windows APIs and would do something like:

Private Declare PtrSafe Function EnumWindows Lib "user32" (ByVal lpEnumFunc As LongPtr, ByVal lParam As LongPtr) As Long
Private Declare PtrSafe Function GetActiveWindow Lib "user32" () As LongPtr
Private Declare PtrSafe Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hWnd As LongPtr, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare PtrSafe Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hWnd As LongPtr) As Long
Private Declare PtrSafe Function IsWindowVisible Lib "user32" (ByVal hWnd As LongPtr) As Boolean

Private colWindowTexts        As Collection


Function GetCurrentWindowTitle() As String
    Dim lHWnd                 As LongPtr
    Dim lWindowTextLength     As Long
    Dim sWindowText           As String

    lHWnd = GetActiveWindow()
    lWindowTextLength = GetWindowTextLength(lHWnd)
    sWindowText = Space$(lWindowTextLength + 1)
    GetWindowText lHWnd, sWindowText, lWindowTextLength + 1

    GetCurrentWindowTitle = Left$(sWindowText, lWindowTextLength)
End Function

Private Function EnumWindowsCallback(ByVal lHWnd As LongPtr, _
                                     ByVal lParam As LongPtr) As Long
    Dim sWindowText           As String * 255
    Dim lWindowTextLength     As Long

    lWindowTextLength = GetWindowText(lHWnd, sWindowText, Len(sWindowText))

    If lWindowTextLength > 0 And IsWindowVisible(lHWnd) Then
        sWindowText = Left(sWindowText, lWindowTextLength)
        colWindowTexts.Add Trim(sWindowText)
    End If

    EnumWindowsCallback = 1
End Function

Function CountWindowsWithTitle(sTitle As String) As Long
    Dim sWindowText           As Variant

    Set colWindowTexts = New Collection

    EnumWindows AddressOf EnumWindowsCallback, 0

    For Each sWindowText In colWindowTexts
        'Debug.Print Trim(sWindowText)    'For debugging purposed
        If Trim(sWindowText) = sTitle Then
            CountWindowsWithTitle = CountWindowsWithTitle + 1
        End If
    Next sWindowText

    Set colWindowTexts = Nothing
End Function

Then using a start up form or an AutoExec macro, we would simply perform the check by doing:

    If CountWindowsWithTitle(GetCurrentWindowTitle()) > 1 Then ' Already an instance running
        MsgBox "The database is already open.", vbInformation, "Database Already Running"
        Application.Quit acQuitSaveNone
    End If

Using the Mutex API

Eugen dropped me a comment mentioning that another possible approach would be to use the Mutex API. So I thought I’d provide an example of the code to make that happen.

#If VBA7 Then
    Private Declare PtrSafe Function CreateMutex Lib "kernel32" Alias "CreateMutexA" (ByVal lpMutexAttributes As LongPtr, ByVal bInitialOwner As Long, ByVal lpName As String) As LongPtr
    Private Declare PtrSafe Function ReleaseMutex Lib "kernel32" (ByVal hMutex As LongPtr) As Long
    Private Declare PtrSafe Function CloseHandle Lib "kernel32" (ByVal hObject As LongPtr) As Long
    'Private Declare PtrSafe Function GetLastError Lib "kernel32" () As Long

    Private lMutexHandle      As LongPtr
#Else
    Private Declare Function CreateMutex Lib "kernel32" Alias "CreateMutexA" (ByVal lpMutexAttributes As Long, ByVal bInitialOwner As Long, ByVal lpName As String) As Long
    Private Declare Function ReleaseMutex Lib "kernel32" (ByVal hMutex As Long) As Long
    Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
    'Private Declare Function GetLastError Lib "kernel32" () As Long

    Private lMutexHandle      As Long
#End If

Private Const ERROR_ALREADY_EXISTS As Long = 183&


Sub CheckSingleInstance(Optional bDebug As Boolean = False)
    Dim sMutexName            As String
    Dim bAlreadyExists        As Boolean

On Error GoTo Error_Handler

    sMutexName = "MyAccessDatabaseMutex"

    If bDebug Then Debug.Print "Attempting to create mutex: " & sMutexName

    lMutexHandle = CreateMutex(0&, True, sMutexName)
    bAlreadyExists = (Err.LastDllError = ERROR_ALREADY_EXISTS)    'GetLastError doesn't work properly!

    If bDebug Then Debug.Print "CreateMutex result: " & lMutexHandle & ", Already Exists: " & bAlreadyExists

    If lMutexHandle = 0 Then
        If bDebug Then Debug.Print "Failed to create or open mutex."
        MsgBox "Failed to create or open mutex.", vbCritical Or vbOKOnly, "Error"
        Application.Quit
    ElseIf bAlreadyExists Then
        If bDebug Then Debug.Print "Another instance is already running."
        MsgBox "Another instance of this database is already running.", _
               vbExclamation Or vbOKOnly, "Application Already Running"
        CloseHandle lMutexHandle
        lMutexHandle = 0
        Application.Quit
    Else
        If bDebug Then Debug.Print "Successfully created mutex. Application can continue."
    End If
    
Error_Handler_Exit:
    On Error Resume Next
    Exit Sub
 
Error_Handler:
    MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
           "Error Source: CheckSingleInstance" & vbCrLf & _
           "Error Number: " & Err.Number & vbCrLf & _
           "Error Description: " & Err.Description & _
           Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
           , vbOKOnly + vbCritical, "An Error has Occurred!"
    Resume Error_Handler_Exit
End Sub

Sub CleanupMutex(Optional bDebug As Boolean = False)
    On Error GoTo Error_Handler

    If lMutexHandle <> 0 Then
        If bDebug Then Debug.Print "Cleaning up mutex"
        ReleaseMutex lMutexHandle
        CloseHandle lMutexHandle
        lMutexHandle = 0
        If bDebug Then Debug.Print "Mutex cleaned up successfully"
    End If

Error_Handler_Exit:
    On Error Resume Next
    Exit Sub

Error_Handler:
    MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
           "Error Source: CleanupMutex" & vbCrLf & _
           "Error Number: " & Err.Number & vbCrLf & _
           "Error Description: " & Err.Description & _
           Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
           , vbOKOnly + vbCritical, "An Error has Occurred!"
    Resume Error_Handler_Exit
End Sub

Now the way I implemented this in the past was to create a form (I called mine ‘StartUp’) that has the following Open and Close events:

Private Sub Form_Close()
    Call CleanupMutex
End Sub

Private Sub Form_Open(Cancel As Integer)
    Call CheckSingleInstance
End Sub

and then I use my AutoExec macro to launch the form hidden to the user at the startup of the database.

Public Function StartUp()
    DoCmd.OpenForm "StartUp", acNormal, , , , acHidden
End Function

This way, regardless of how the database is closed, the form’s close event fires and cleans up the Mutex instance.

Now, Mutex coding can be more complicated as we could get into validating for abandoned Mutex instances from crashes or improper shutdowns and the likes… but the OS appears to reliably release the instance anyways, so it does not appear to be necessary in VBA at least. More testing could be done on this front. But this has never been an issue for me thus far.
 

Conclusion

So, above I’ve provided 3 possible ways of stopping users from opening multiple instances of the same database, the choice is yours.

By taking such steps, you ultimately are reducing the chance of confusion and errors from occurring, helping with overall resource consumption which can impact overall database and PC performance and even avoid data integrity issues arising from data conflicts and potential loss of changes from having the same records open in different instances of the database.
 

Page History

Date	Summary of Changes
2025-02-10	Initial Release