How to check if Access DB is already open. (1 Viewer)

NauticalGent

Ignore List Poster Boy
Local time
Today, 17:02
Joined
Apr 27, 2015
Messages
6,321
Hello SportsFans,

I have inherited an application that is a real piece of work. The original author was VBA-centric and pretty much used Access for tables and forms only. The others that can after him were more Access oriented and used sites, this one included, to figure out how to make changes/updates.

One of the "updates" was the introduction of the code on this thread:

http://www.access-programmers.co.uk/forums/showthread.php?t=217400&highlight=Hide+access+window

Not a big fan of it and I intend to take it out - but for now I have a more pressing issue. Because of the 'lock-down' nature of this code, users can only view one form at a time (another issue I will tackle). There are times they need to see other data and instead of closing the current form and opening the one they want, they open the DB again using the FE on their local computer (I forgot to mention the DB is split).

I have been there for 2 weeks and I have had to do "surgery" at least once due to corrupted data. I have advised the users not to do this, but there are some rebels out there and I don't like to leave things to chance...

What I would like to do is put in some code that detects if the DB is already open and if so, quit the newly open instance but keep the other instance open.

As always, thanks in advance!
 

arnelgp

..forever waiting... waiting for jellybean!
Local time
Tomorrow, 05:02
Joined
May 7, 2009
Messages
19,229
to check if the current db is already open:

Code:
#If Win64 Then
Private Declare PtrSafe Function apiIsIconic Lib "user32" Alias "IsIconic" (ByVal hwnd As Long) As Long
Private Declare PtrSafe Function apiShowWindowAsync Lib "user32" Alias "ShowWindowAsync" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Boolean
#Else
Private Declare Function apiIsIconic Lib "user32" Alias "IsIconic" (ByVal hwnd As Long) As Long
Private Declare Function apiShowWindowAsync Lib "user32" Alias "ShowWindowAsync" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Boolean
#End If
Private Const SW_RESTORE As Long = 9
Private Const SW_SHOW As Long = 5
'
 
Public Sub CheckMultipleInstances()
   Dim appAccess As Access.Application
   Set appAccess = GetObject(CurrentProject.FullName)
   If appAccess.hWndAccessApp = Application.hWndAccessApp Then
      'Same instance. Proceed
      Else
      MsgBox "You allready have an instance of " & CurrentProject.Name & " running"
      'Active the other access app
         ActivateAccessApp appAccess.hWndAccessApp
      'Clear reference to it
         Set appAccess = Nothing
      
      'Close down this app
         DoCmd.Quit
   End If
   Set appAccess = Nothing
End Sub
 
#if win64 then
Public Sub ActivateAccessApp(hWndApp As LongPtr)
#else 
Public Sub ActivateAccessApp(hWndApp As Long)
#end if
   If apiIsIconic(hWndApp) Then
      apiShowWindowAsync hWndApp, SW_RESTORE
   Else
       apiShowWindowAsync hWndApp, SW_SHOW
   End If
End Sub
 

NauticalGent

Ignore List Poster Boy
Local time
Today, 17:02
Joined
Apr 27, 2015
Messages
6,321
Arnelgp, as always, your help is timely, on-point and MUCH appreciated!

Thanks again...
 

Users who are viewing this thread

Top Bottom