You need something like the following:
Declare Function OpenProcess _
Lib "kernel32" _
(ByVal dwDesiredAccess As Long, _
ByVal bInheritHandle As Long, _
ByVal dwProcessId As Long) As Long
Declare Function CloseHandle _
Lib "kernel32" _
(ByVal hObject As Long) As Long
Declare Function WaitForSingleObject _
Lib "kernel32" _
(ByVal hHandle As Long, _
ByVal dwMilliseconds As Long) As Long
Declare Function GetLastError Lib "kernel32" () As Long
Declare Function GetExitCodeProcess Lib "kernel32" (ByVal hProcess As Long,
lpExitCode As Long) As Long
Option Explicit
' -- used by ShellWait
Private Const SYNCHRONIZE As Long = &H100000
Private Const PROCESS_QUERY_INFORMATION As Long = &H400
Private Const STILL_ACTIVE As Long = &H103
Private Const ERROR_ACCESS_DENIED As Long = 5
Private Const INVALID_HANDLE_VALUE As Long = -1
' -- used by ShellWait
'Private Declare Function OpenProcess Lib "kernel32" _
' (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal
dwProcessId As Long) As Long
'Private Declare Function GetExitCodeProcess Lib "kernel32" _
' (ByVal hProcess As Long, lpExitCode As Long) As Long
'
'========================================================================
'==============
' Routine : ShellWait
' Description : Allows a caller to shell a command line and wait until it
completes.
' Parameters : Identical in name and functionality to that of the
VBA.Shell function.
' RETURNS : A long value that defines how the shell application
exited [ignored]. The SDK says:
'
' If the process has terminated, the termination status returned may be
one of the following:
' * The exit value specified in the ExitProcess or TerminateProcess
function.
' * The return value from the main or WinMain function of the process.
' * The exception value for an unhandled exception that caused the
process to terminate.
'
' History : 08/04/99 -- MONTE HANSEN -- Creation
'
'========================================================================
'==============
Public Function ShellWait(ByVal PathName As String, Optional ByVal
WindowStyle As VbAppWinStyle = vbNormalFocus) As Long
Dim hInstance As Long ' hInstance of shelled application
Dim hProcess As Long ' hProcess of shelled application
Dim nRetVal As Long ' generic return value; debugging only
' No error handler. Errors reflected back. Errors also thrown to caller.
' Shell the command; an error raises if fails
hInstance = Shell(PathName, WindowStyle)
' clear the LastDLLError [system error] value
Err.Clear
' open the process of the just shelled application
hProcess = OpenProcess(PROCESS_QUERY_INFORMATION Or SYNCHRONIZE, 1&,
hInstance)
Select Case hProcess
Case 0, INVALID_HANDLE_VALUE
' Failure is most likely access denied to the process
Select Case Err.LastDllError
Case ERROR_ACCESS_DENIED
Err.Raise 70 ' VB's version of "Access Denied"
Case Else
Err.Raise 5, Description:="There was an unknown error opening the
shelled process. " & "System error #" & Err.LastDllError & "."
End Select
'Case Else: Is a valid handle to a process
End Select
' loop until we get an exit code for the process
Do
nRetVal = GetExitCodeProcess(hProcess, ShellWait)
' We should never stop here
Debug.Assert CBool(nRetVal)
' optional but recommended unless there is something
' better available that uses less CPU cycles.
DoEvents
Loop While ShellWait = STILL_ACTIVE
ExitLabel:
Exit Function
End Function
--
Regards,
Adrian Jansen
J & K MicroSystems
Microcomputer solutions for industrial control
No Spam said:
I have some program vendors that will let me install my programs on all the
PCs provided I am able to limit how many people are using the program
simultaneously. I would like to write a small utility in access that will
keep track of how many users are currently in the program.
I know that I can open a program with code, but I would like to know if
there is a way I can detect when the program ends?
For instance I can open the application and detect if it opened correctly
with the Shell function:
Dim RetVal
RetVal = Shell("C:\WINDOWS\CALC.EXE", 1) ' Run Calculator.
But how can I tell when the application closes?
