 | Administrator | | Join Date: Oct 2006 Location: London - UK
Posts: 15,730
# 1
Sep 29 '08
| |
Introduction :
The following code (module) provides the facility to execute a program, but synchronously. The Shell() function executes a command and returns immediately the command has been invoked. This is often not appropriate, so here is a version which causes the invoking code to wait until the command has completed execution. Solution : - Option Compare Database
-
Option Explicit
-
-
'Windows API Variable Prefixes
-
'cb = Count of Bytes (32-bit)
-
'w = Word (16-bit)
-
'dw = Double Word (32-bit)
-
'lp = Long Pointer (32-bit)
-
'b = Boolean (32-bit)
-
'h = Handle (32-bit)
-
'ul = Unsigned Long (32-bit)
-
-
Private Const conUseShowWindow = &H1&
-
Private Const conNormalPriority = &H20&
-
Private Const conInfinite = -1&
-
-
Private Type typStartupInfo
-
cbLen As Long
-
lpReserved As String
-
lpDesktop As String
-
lpTitle As String
-
dwX As Long
-
dwY As Long
-
dwXSize As Long
-
dwYSize As Long
-
dwXCount As Long
-
dwYCount As Long
-
dwFillAtt As Long
-
dwFlags As Long
-
wShowWindow As Integer
-
cbReserved2 As Integer
-
lpReserved2 As Long
-
hStdIn As Long
-
hStdOut As Long
-
hStdErr As Long
-
End Type
-
-
Private Type typProcInfo
-
hProc As Long
-
hThread As Long
-
dwProcID As Long
-
dwThreadID As Long
-
End Type
-
-
Private Declare Function CreateProcessA Lib "kernel32" ( _
-
ByVal lpApplicationName As Long, _
-
ByVal lpCommandLine As String, _
-
ByVal lpProcessAttributes As Long, _
-
ByVal lpThreadAttributes As Long, _
-
ByVal bInheritHandles As Long, _
-
ByVal dwCreationFlags As Long, _
-
ByVal lpEnvironment As Long, _
-
ByVal lpCurrentDirectory As Long, _
-
lpStartupInfo As typStartupInfo, _
-
lpProcessInformation As typProcInfo) As Long
-
Private Declare Function WaitForSingleObject Lib "kernel32" ( _
-
ByVal hHandle As Long, _
-
ByVal dwMilliseconds As Long) As Long
-
Private Declare Function CloseHandle Lib "kernel32" ( _
-
ByVal hObject As Long) As Long
-
-
'ShellWait() executes a command synchronously (Shell() works asynchronously).
-
Public Sub ShellWait(strCommand As String, _
-
Optional intWinStyle As Integer = vbNormalFocus)
-
Dim objProcInfo As typProcInfo
-
Dim objStart As typStartupInfo
-
-
'Initialize the typStartupInfo structure:
-
With objStart
-
.cbLen = Len(objStart)
-
.dwFlags = conUseShowWindow
-
.wShowWindow = intWinStyle
-
End With
-
'Start the shelled application:
-
Call CreateProcessA(lpApplicationName:=0&, _
-
lpCommandLine:=strCommand, _
-
lpProcessAttributes:=0&, _
-
lpThreadAttributes:=0&, _
-
bInheritHandles:=1&, _
-
dwCreationFlags:=conNormalPriority, _
-
lpEnvironment:=0&, _
-
lpCurrentDirectory:=0&, _
-
lpStartupInfo:=objStart, _
-
lpProcessInformation:=objProcInfo)
-
'Wait for the shelled application to finish
-
Call WaitForSingleObject(hHandle:=objProcInfo.hProc, _
-
dwMilliseconds:=conInfinite)
-
Call CloseHandle(hObject:=objProcInfo.hProc)
-
End Sub
|
