Check if another Access is running (1 Viewer)

[Kenln]

I have been looking at the code from Microsoft for looking for applications to see if they are running.

If you change the lpClassName to "OMain" that works for Access. The caption is a bit of a problem since in Access the caption is not only the program (application) title but also the form caption. It can work but there is no way to know which form might be in use.

I would like to check if another (specific) Access app is running and if not launch it.

Checking for the .ldb will not work if the file was closed improperly.

Another option might simply be to check if it exist (on the harddrive) and launch it regardless.

Any ideas???

Thank you,

Function CalculatorUp ()

   Const lpClassName = "SciCalc"
   Const lpCaption = "Calculator"

   'This demonstrates three different ways to call FindWindow:
      '1. The ClassName only.
      '2. The Caption only.
      '3. Both the ClassName and the Caption

   MsgBox "Calculator Handle = " & FindWindow(lpClassName, _
         VBNullString)
   MsgBox "Calculator Handle = " & FindWindow(VBNullString, _
         lpCaption)
   MsgBox "Calculator Handle = " & FindWindow(lpClassName, _
         lpCaption)

   'This function could return the handle of a window.
   CalculatorUp = FindWindow(lpClassName, 0&)
End Function

 

[Guus2005]

Using the code below, you can check for multiple instances of the same Access database. But i am not sure how to check for any Access database.

HTH

Option Compare Database
Option Explicit

'RunCode
'    =winCheckMultipleInstances(False)

'******************** Code Start ********************
' Module mdlCheckMultipleInstances
' © Graham Mandeno, Alpha Solutions, Auckland, NZ
' graham@alpha.co.nz
' This code may be used and distributed freely on the condition
'  that the above credit is included unchanged.
 
Private Const cMaxBuffer = 255
Private Const GW_CHILD = 5
Private Const GW_HWNDNEXT = 2
 
Private Declare Function apiGetClassName Lib "user32" Alias "GetClassNameA" _
                    (ByVal hWnd As Long, ByVal lpClassName As String, _
                     ByVal nMaxCount As Long) As Long
Private Declare Function apiGetDesktopWindow Lib "user32" Alias "GetDesktopWindow" () As Long
Private Declare Function apiGetWindow Lib "user32" Alias "GetWindow" _
                    (ByVal hWnd As Long, ByVal wCmd As Long) As Long
Private Declare Function apiGetWindowText Lib "user32" Alias "GetWindowTextA" _
                   (ByVal hWnd As Long, ByVal lpString As String, ByVal aint As Long) As Long
Private Declare Function apiSetActiveWindow Lib "user32" Alias "SetActiveWindow" (ByVal hWnd As Long) As Long
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 Long
 
Private Const SW_SHOW = 5
Private Const SW_RESTORE = 9

Public Function winGetClassName(hWnd As Long) As String
    Dim sBuffer As String, iLen As Integer
    sBuffer = String$(cMaxBuffer - 1, 0)
    iLen = apiGetClassName(hWnd, sBuffer, cMaxBuffer)
    If iLen > 0 Then
        winGetClassName = VBA.Left$(sBuffer, iLen)
    End If
End Function
 
Public Function winGetTitle(hWnd As Long) As String
    Dim sBuffer As String, iLen As Integer
    sBuffer = String$(cMaxBuffer - 1, 0)
    iLen = apiGetWindowText(hWnd, sBuffer, cMaxBuffer)
    If iLen > 0 Then
        winGetTitle = VBA.Left$(sBuffer, iLen)
    End If
End Function
 
Public Function winGetHWndDB(Optional hWndApp As Long) As Long
    Dim hWnd As Long
    winGetHWndDB = 0
    If hWndApp <> 0 Then
        If winGetClassName(hWndApp) <> "OMain" Then Exit Function
    End If
    hWnd = winGetHWndMDI(hWndApp)
    If hWnd = 0 Then Exit Function
    hWnd = apiGetWindow(hWnd, GW_CHILD)
    Do Until hWnd = 0
        If winGetClassName(hWnd) = "ODb" Then
            winGetHWndDB = hWnd
            Exit Do
        End If
        hWnd = apiGetWindow(hWnd, GW_HWNDNEXT)
    Loop
End Function
 
Public Function winGetHWndMDI(Optional hWndApp As Long) As Long
    Dim hWnd As Long
    winGetHWndMDI = 0
    If hWndApp = 0 Then hWndApp = Application.hWndAccessApp
    hWnd = apiGetWindow(hWndApp, GW_CHILD)
    Do Until hWnd = 0
        If winGetClassName(hWnd) = "MDIClient" Then
            winGetHWndMDI = hWnd
            Exit Do
        End If
    hWnd = apiGetWindow(hWnd, GW_HWNDNEXT)
    Loop
End Function
 
Public Function winCheckMultipleInstances(Optional fConfirm As Boolean = True) As Boolean
    Dim fSwitch As Boolean, sMyCaption As String
    Dim hWndApp As Long, hWndDb As Long
    On Error GoTo ProcErr
    sMyCaption = winGetTitle(winGetHWndDB())
    hWndApp = apiGetWindow(apiGetDesktopWindow(), GW_CHILD)
    Do Until hWndApp = 0
    If hWndApp <> Application.hWndAccessApp Then
        hWndDb = winGetHWndDB(hWndApp)
        If hWndDb <> 0 Then
            If sMyCaption = winGetTitle(hWndDb) Then Exit Do
        End If
    End If
    hWndApp = apiGetWindow(hWndApp, GW_HWNDNEXT)
  Loop
  If hWndApp = 0 Then Exit Function
    If fConfirm Then
        If MsgBox(sMyCaption & " is already open@" _
            & "Do you want to open a second instance of this database?@", _
            vbYesNo Or vbQuestion Or vbDefaultButton2) = vbYes Then Exit Function
    End If
    apiSetActiveWindow hWndApp
    If apiIsIconic(hWndApp) Then
        apiShowWindowAsync hWndApp, SW_RESTORE
    Else
        apiShowWindowAsync hWndApp, SW_SHOW
    End If
    Application.Quit
ProcEnd:
    Exit Function
ProcErr:
    MsgBox Err.Description
    Resume ProcEnd
End Function

 

[Kenln]

How does this work?

 

[ErikSnoek]

Or this code, which gives you a function like FindWindow except you can use wildcards in the caption which means you can just use the application title regardless of what form is opened.

Option Explicit
[COLOR=green]
' Module Name: ModFindWindowLike
' (c) 2005 Wayne Phillips (http://www.everythingaccess.com)
' Written 02/06/2005[/COLOR]
					
Private Declare Function EnumWindows Lib "user32" _
   (ByVal lpEnumFunc As Long, _
    ByVal lParam As Long) As Long

Private Declare Function GetWindowText Lib "user32" _
    Alias "GetWindowTextA" _
   (ByVal hWnd As Long, _
    ByVal lpString As String, _
    ByVal cch As Long) As Long

[COLOR=green]'Custom structure for passing in the parameters in/out of the hook enumeration function
'Could use global variables instead, but this is nicer.[/COLOR]
Private Type FindWindowParameters

    strTitle As String  [COLOR=green]'INPUT[/COLOR]
    hWnd As Long        [COLOR=green]'OUTPUT[/COLOR]

End Type

Public Function FnFindWindowLike(strWindowTitle As String) As Long

    'We'll pass a custom structure in as the parameter to store our result...
    Dim Parameters As FindWindowParameters
    Parameters.strTitle = strWindowTitle [COLOR=green]' Input parameter[/COLOR]

    Call EnumWindows(AddressOf EnumWindowProc, VarPtr(Parameters))
    
    FnFindWindowLike = Parameters.hWnd
    
End Function

Private Function EnumWindowProc(ByVal hWnd As Long, _
                               lParam As FindWindowParameters) As Long
   
   Dim strWindowTitle As String

   strWindowTitle = Space(260)
   Call GetWindowText(hWnd, strWindowTitle, 260)
   strWindowTitle = TrimNull(strWindowTitle) [COLOR=green]' Remove extra null terminator[/COLOR]
                                          
   If strWindowTitle Like lParam.strTitle Then
   
        lParam.hWnd = hWnd [COLOR=green]'Store the result for later.[/COLOR]
        EnumWindowProc = 0 [COLOR=green]'This will stop enumerating more windows[/COLOR]
   
   End If
                           
   EnumWindowProc = 1

End Function

Private Function TrimNull(strNullTerminatedString As String)

    Dim lngPos As Long

    [COLOR=green]'Remove unnecessary null terminator[/COLOR]
    lngPos = InStr(strNullTerminatedString, Chr$(0))
   
    If lngPos Then
        TrimNull = Left$(strNullTerminatedString, lngPos - 1)
    Else
        TrimNull = strNullTerminatedString
    End If
   
End Function

 

[Kenln]

When I run this with Calculator as the input it works (when the calculator is running), but I cannot seem to get it to reconize and Access window, email window, web window etc???

I have tried entering the full caption and the partial caption. What am I suppose to use as the input???

 

[Kenln]

I can run this and it works except:
If the app is already open it tries to open another instance. It can't so it opens a blank DB window.

'Define as Static so the instance of Access
'doesn't close when the procedure ends.
Static acc As Access.Application
Dim db As DAO.Database
Dim strDbName As String

     strDbName = "C:\Test\Test_File.mde"
     Set acc = New Access.Application
     acc.Visible = True

     Set db = acc.DBEngine.OpenDatabase(strDbName, False, False)
     acc.OpenCurrentDatabase strDbName
     db.Close
     Set db = Nothing

 

[Guus2005]

'Dont:
'Define as Static so the instance of Access
'doesn't close when the procedure ends.
'Do:
'define as a global variable instead. in a module.
'Or:
'pass it along as an argument to your procedures

Dim acc As Access.Application
' \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\

Dim db As DAO.Database
Dim strDbName As String

if FindWindowLike("Microsoft Access") = 0 then ' Not found

     strDbName = "C:\Test\Test_File.mde"
     Set acc = New Access.Application
     acc.Visible = True

     Set db = acc.DBEngine.OpenDatabase(strDbName, False, False)
     acc.OpenCurrentDatabase strDbName
     db.Close
     Set db = Nothing

endif

Enjoy!

 

[mearle]

A neater alternative might be to use the GetObject function, eg
Dim acc As Application
Set acc = GetObject(strDatabasePath)

I believe this will return a reference to the instance of access which has this database file open, or if not already open, it will start a new instance of access, and open the file. Either way, you have a reference to this new or existing access application.
http://msdn.microsoft.com/en-us/library/aa445016(VS.60).aspx

 

[Kenln]

A couple of questions.

1) Guus2005
Instead of FindWindowLike, do you mean FnFindWindowLike?
Also what does

if FindWindowLike("Microsoft Access") = 0 then ' Not found

do???

2) mearle
This looks like an easy solution without opening a new instance if it is always running. But how would you open a password protected database?

I appreciate all of your help,

 

[mearle]

In the case that the database is not already open, the user would enter the password in the access dialog box that automatically appears, in just the same way as when somebody manually opens the same database through Access.

 

[Guus2005]

A couple of questions.

1) Guus2005
Instead of FindWindowLike, do you mean FnFindWindowLike?
Also what does

if FindWindowLike("Microsoft Access") = 0 then ' Not found

do???

Yes, sorry for the mix up. I have made a minor change to the function name, i removed the fn prefix. It didn't fit my naming convention.

FindWindowLike returns a number. If it is 0, the window with that name was not found.

Keep in mind that when you change the caption of the application using the startup options, the function returns 0 when you try to find "Microsoft Access"

HTH

 

[Kenln]

I do change the caption. I tried using what I change the caption to and it does not work either.

 

[Kenln]

Our security is unique I think.
We have fe/be databases. The be network have Windows Group Security Policies.
The fe is a password protected mde with the shift function disabled.
The is a seperate mde (again with the shift function disabled) that opens the fe.

The users do not know the password so they couldn't type it in.

 

[Kenln]

So far it is easy to open the database with various methods being available.

But it appears that we have not found anything that could tell us if a specific database is already open. It is easy to see if an instance of Access is running but not which database.

This seems to be the major hurdle.

 

[ErikSnoek]

When you use the fnFindWindowLike function, do you use it like this?

fnFindWindowLike("YourTitle*")

Note the asterisk which indicates that the title should start with "YourTitle" and can have any text behind it.

 

[Kenln]

Sucess!!!!

Yeah!!!!

Thank you,

 

[ecawilkinson]

Our security is unique I think.
We have fe/be databases. The be network have Windows Group Security Policies.
The fe is a password protected mde with the shift function disabled.
The is a seperate mde (again with the shift function disabled) that opens the fe.

The users do not know the password so they couldn't type it in.

Why do you have 2 frontends? I assume the first frontend must do some sort of look up which verifies the user's security, which in turn opens the 2nd front end. If that is the case, why not just have the lookup in the 2nd front-end and remove the password protection. as you have disabled the shift key, you can use the some startup code to do the lookup, which shuts down Access if the user is not valid. Obviously password protect the VBA code. In fact, reading this link will show you how to prevent anyone breaking into your code. If you read further down it will show you how where to put code that cannot be stopped (Autoexec can be halted with CTRL+BREAK if you do it in the right place).

HTH,
Chris

 

[Kenln]

The other reason for the password is not to allow imports of the underlying queries and tables.

This is easily done with a new blank Access Database.

I will lookingo the Ctrl+Break further.


Thanks.