Google Groups no longer supports new Usenet posts or subscriptions. Historical content remains viewable.
Dismiss

external application finished?

26 views
Skip to first unread message

Frank Bieser

unread,
Dec 12, 1996, 3:00:00 AM12/12/96
to
excel

Jim Rech

unread,
Dec 12, 1996, 3:00:00 AM12/12/96
to

Try this:

'-- 32 bit ---
Declare Function OpenProcess Lib "kernel32" _
(ByVal dwDesiredAccess As Long, _
ByVal bInheritHandle As Long, _
ByVal dwProcessId As Long) As Long

Declare Function GetExitCodeProcess Lib "kernel32" _
(ByVal hProcess As Long, _
lpExitCode As Long) As Long

Public Const PROCESS_QUERY_INFORMATION = &h400
Public Const STILL_ACTIVE = &h103

'-- 16 bit --
Declare Function GetModuleUsage Lib "kernel" _
(ByVal hModule As Integer) As Integer

Sub Test()
Dim StartTime As Double
StartTime = Now
ShellAndWait "calc.exe", 1
MsgBox "Gone " & Format(Now - StartTime, "s") & " seconds"
End Sub

'Window States (Per Help for Shell function):
' 1, 5, 9 Normal with focus.
' 2 Minimized with focus.
' 3 Maximized with focus.
' 4, 8 Normal without focus.
' 6, 7 Minimized without focus.
Sub ShellAndWait(ByVal PathName As String, Optional WindowState)
Dim hProg As Long
Dim hProcess As Long, ExitCode As Long

'fill in the missing parameter and execute the program
If IsMissing(WindowState) Then WindowState = 1
hProg = Shell(PathName, WindowState)

If InStr(1, Application.OperatingSystem, "32") <> 0 Then
'32 bit approach
'hProg is a "process ID under Win32. To get the process
handle:
hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, False,
hProg)
Do
'populate Exitcode variable
GetExitCodeProcess hProcess, ExitCode
DoEvents
Loop While ExitCode = STILL_ACTIVE
Else
'16 bit approach
While GetModuleUsage(hProg) > 0
DoEvents
Wend
End If
End Sub


0 new messages