How does one DB conditionally launch another

[GraeagleBill]

I have a case where one app opens via the Task Scheduler, and I want that app to test for the presents of a 2nd app and start it if it's not already running. How does one do that? I don't want to end up with multiple instances of the 2nd app.

Thanks,
Bill

[Gicu]

I have an older module with a couple of functions that would help, you might need to adapt it for the 64 bit version of Access:

Option Compare Database
Option Explicit


'******************** 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 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 Const GW_CHILD = 5
Private Const GW_HWNDNEXT = 2
 
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 strISP_FRONT_END_TITLE As String


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 = 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 = 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 strPartialName As String, 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
'modified by Vlad on Nov 11, 2005
'added strPartialName string to allow checking for any passed db, not only current
  
  winCheckMultipleInstances = False
  sMyCaption = IIf(strPartialName = "", winGetTitle(winGetHWndDB()), strPartialName)
  
  hWndApp = apiGetWindow(apiGetDesktopWindow(), GW_CHILD)
  Do Until hWndApp = 0
    If hWndApp <> Application.hWndAccessApp Then
      hWndDb = winGetHWndDB(hWndApp)
      If hWndDb <> 0 Then
      Dim S
      S = winGetTitle(hWndDb)
        If InStr(S, sMyCaption) > 0 Then
        strISP_FRONT_END_TITLE = S
            Exit Do
        End If
      End If
    End If
    hWndApp = apiGetWindow(hWndApp, GW_HWNDNEXT)
  Loop
  
    If hWndApp = 0 Then
        winCheckMultipleInstances = False
    Else
        winCheckMultipleInstances = True
    End If
     


ProcEnd:
  Exit Function
ProcErr:
  MsgBox Err.Description
  Resume ProcEnd
End Function
'******************** Code End ********************


Public Function winShowInstances(Optional strPartialName As String, 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 = IIf(strPartialName = "", winGetTitle(winGetHWndDB()), strPartialName)
  
  hWndApp = apiGetWindow(apiGetDesktopWindow(), GW_CHILD)
  Do Until hWndApp = 0
    If hWndApp <> Application.hWndAccessApp Then
      hWndDb = winGetHWndDB(hWndApp)
      If hWndDb <> 0 Then
      Dim S
      S = winGetTitle(hWndDb)
        If InStr(S, sMyCaption) > 0 Then
            Exit Do
        End If
      End If
    End If
    hWndApp = apiGetWindow(hWndApp, GW_HWNDNEXT)
  Loop
    
  
  apiSetActiveWindow hWndApp
  
  If apiIsIconic(hWndApp) Then
    apiShowWindowAsync hWndApp, SW_RESTORE
  Else
    apiShowWindowAsync hWndApp, SW_SHOW
  End If
  AppActivate winGetTitle(hWndApp)
  
ProcEnd:
  Exit Function
ProcErr:
  MsgBox Err.Description
  Resume ProcEnd




End Function

Cheers,

[Welshgasman]

Test for the lock file of the 2nd app?

[isladogs]

Paul
If opened exclusively there is no lock file

Bill
There is a simple way of doing this with no APIs. In a way its similar to the lock file idea.
When the 2nd app is opened use code in the startup form or autoexec macro to create a text file in the same folder. Call it e.g. test.txt.
When the 2nd app is closed, get it to kill test.txt

So all you need to do is to check if the file test.txt exists. If so, the 2nd app is running

[GraeagleBill]

Thanks Colin. While It's not likely I'd run into a problem with Paul's suggestion, one can safely bet that as soon as I do I'd get creamed with a conflict in the midst of editing or crashing the app.
Thanks to you both,
Bill

[isladogs]

On behalf of us all, you're welcome

[GraeagleBill]

I wanted to test Paul's suggestion, and while the test works okay, the 2nd app didn't start.

Private Sub StartMonitor()
'*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*
'  Task has completed its functionality, start the monitor if it's not already running.
'*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*
Dim appAccess As New Access.Application


If Len(Dir("c:\Meds\Meds-V2.0.laccdb")) = 0 Then
    MsgBox "Going to open monitor"
    appAccess.OpenCurrentDatabase ("c:\Meds\Meds-V2.0.accdb")
End If


DoCmd.Quit                                        'That's everybody for current period, adios


End Sub

Apparently not launching 2nd app correctly. It should open a form with the Access window hidden, as I use Colin's method to hide Access.


EDIT: Ran again without the confirming Msgbox and the 2nd app opens, but the Access Window IS NOT hidden.

EDIT2: I'm baffled, sometime the 2nd app opens and sometimes it doesn't. And again, it never opens with the Access Window hidden as it normally would.

EDIT3: Well, here's why it wouldn't start, but the 2nd app IS NOT displaying.
Why the 2nd app didn't close up properly isn't at all clear, but the residuals in the Task Mgr at least show the linkering:

[isladogs]

Just about to sign off for tonight and too tired to study your code.
However the attached code is what I use to open an external database with lots of possible variations to select from.

Public Function RunExternalDatabase() As Boolean
    
    Dim app As Access.Application, strPath As String
    'Start a new MSAccess application
    Set app = New Access.Application
    
    'Open the remote database, then close the current (or remote) database
    With app
        'Syntax: .OpenCurrentDatabase(filepath, Exclusive, strPassword) - the last 2 items are optional
        
       '  strPath = "C:\Programs\MendipDataSystems\JATFA\JATFA.accdb" 'replace with your file path
        ' strPath = "C:\Programs\MendipDataSystems\SDALink\SDALink.accdb" '/cmd AttMarks" 'optional command switch
         strPath = CurrentProject.Path & "\TEST.accdb" 'full file path to your database
         .OpenCurrentDatabase strPath, False 'no db password
     '   .OpenCurrentDatabase strPath, True, "password" 'for use if password exists
         .Visible = True
         
    '    .DoCmd.RunMacro "mcrRefreshPersTable" 'optional - run your macro
       ' .CloseCurrentDatabase 'closes external database as that is current
    End With
    
    'Quit the spawned app - DISABLED as not wanted here
    'app.Quit acQuitSaveNone
    'Set app = Nothing
    
    'Quit the current app
   'Application.Quit acQuitSaveNone
    
End Function

One option included in that code is to open the external database exclusively.
Of course that will error if the external DB is already open but will otherwise work

You could use that approach instead, in which case you no longer need to test for a lock file

[GraeagleBill]

Sleep well my friend, I'll pursue more of this tomorrow.

EDIT:

RunExternalDatabase

That did the "trick"

Thanks,
Bill