Shell And Wait
This pages describes the VBA Shell function and provides a procedure that will wait for a Shell'd function to terminate.
The Shell Function
The VBA Shell function can be used to start an external program or perform any operation for which you would normally use the Run item on the Windows start menu. The Shell function starts the command text and then immediately returns control back to the calling VBA code -- it does not wait for the command used in Shell to terminate. This page describes a function named ShellAndWait that will call the Shell function and then wait for the Shell'd process to terminate or for a prescribed timeout interval to expire.
The ShellAndWait Function
The ShellAndWait function calls Shell and then waits for the Shell'd process to terminate. You can specify an interval after which the function times out and returns to the caller. The declaration of ShellAndWait is as follows:
Public Function ShellAndWait(ShellCommand As String, _ TimeOutMs As Long, _ ShellWindowState As VbAppWinStyle, _ BreakKey As ActionOnBreak) As ShellAndWaitResult
In the declaration, ShellCommand is the string that is passed to the VBA Shell function. TimeOutMs is the number of milliseconds to wait before returning a time-out result. ShellWindowsState is an item in theVbAppWinStyle enum that specifies the window style in which to open the Shell'd process. This value is simply passed through to the Shell function. BreakKey indicates how to handle the Application's Cancel key (CTRL BREAK). These parameters are described below.
ShellCommand
This parameter is the command text that is passed to the Shell function. This must be a valid command string; that is, a string that would work in the Run dialog on the Windows Start menu. If the text is invalid (such as attempting to execute a non-existant exe file), the function returns a result indicating failure.
TimeOutMs
This parameter specifies the number of milliseconds to wait for the Shell'd process to terminate. If the specified interval expires before the process ends, the wait is abandoned and the function returns a value indicating a time out occurred. If TimeOutMs is 0, the wait never expires and ShellAndWait will wait indefinitely for the process to terminate.
ShellWindowState
This parameter should be one of the values in the VbAppWinStyle enum that indicates the type of window (e.g., maximized or minimized) in which the Shell'd process should open. This value is simply passed through to theShell command. If this value is not valid, the function returns a result indicating failure.
BreakKey
This parameter should be one of the values in the ActionOnBreak enum to indicate how the code should respond if the user presses CTRL Break. If BreakKey is IgnoreBreak, the cancel key is ignored. If BreakKey isAbandonWait, the wait is terminated and the function returns a valid indicating that the user abandoned the wait. IfBreakKey is PromptUser, the function displays a vbYesNo message box asking the user whether to abandon or continue waiting. The ActionOnBreak enum is shown below.
Public Enum ActionOnBreak IgnoreBreak = 0 AbandonWait = 1 PromptUser = 2 End Enum
Return Values
The function returns as its result one of the values in the ShellAndWaitResult enum, shown below:
Public Enum ShellAndWaitResult Success = 0 Failure = 1 TimeOut = 2 InvalidParameter = 3 SysWaitAbandoned = 4 UserWaitAbandoned = 5 UserBreak = 6 End Enum
Success indicates that the Shell'd process terminated successfully before the TimeOutMs interval expired. M
Failure indicates that the Shell function failed, most likely due to an invalid command string in theShellCommand parameter.
TimeOut indicates that the interval specified by TimeOutMs expired before the process terminated. This result is returned only if TimeOutMs is greater than zero.
InvalidParameter indicates that one of the parameters passed to ShellAndWait is invalid.
SysWaitAbandoned indicates that Windows abandoned the wait operation for internal reasons.
UserWaitAbandoned indicates that the user abandoned the wait operation by pressing CTRL Break. This is returne only if BreakKey is set to AbandonWait.
UserBreak indicates that the user press CTRL Break to terminate the wait and responded "no" to the "continue to wait" prompt. This value is returned only when BreakKey is set to PromptUser.
Failure indicates that the Shell function failed, most likely due to an invalid command string in theShellCommand parameter.
TimeOut indicates that the interval specified by TimeOutMs expired before the process terminated. This result is returned only if TimeOutMs is greater than zero.
InvalidParameter indicates that one of the parameters passed to ShellAndWait is invalid.
SysWaitAbandoned indicates that Windows abandoned the wait operation for internal reasons.
UserWaitAbandoned indicates that the user abandoned the wait operation by pressing CTRL Break. This is returne only if BreakKey is set to AbandonWait.
UserBreak indicates that the user press CTRL Break to terminate the wait and responded "no" to the "continue to wait" prompt. This value is returned only when BreakKey is set to PromptUser.
You can download a module file containing the code.
The complete code module is shown below.
Option Explicit Option Compare Text ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' modShellAndWait ' By Chip Pearson, chip@cpearson.com, www.cpearson.com ' This page on the web site: www.cpearson.com/Excel/ShellAndWait.aspx ' 9-September-2008 ' ' This module contains code for the ShellAndWait function that will Shell to a process ' and wait for that process to end before returning to the caller. ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Private Declare Function WaitForSingleObject Lib "kernel32" ( _ ByVal hHandle As Long, _ ByVal dwMilliseconds As Long) As Long Private Declare Function OpenProcess Lib "kernel32.dll" ( _ ByVal dwDesiredAccess As Long, _ ByVal bInheritHandle As Long, _ ByVal dwProcessId As Long) As Long Private Declare Function CloseHandle Lib "kernel32" ( _ ByVal hObject As Long) As Long Private Const SYNCHRONIZE = &H100000 Public Enum ShellAndWaitResult Success = 0 Failure = 1 TimeOut = 2 InvalidParameter = 3 SysWaitAbandoned = 4 UserWaitAbandoned = 5 UserBreak = 6 End Enum Public Enum ActionOnBreak IgnoreBreak = 0 AbandonWait = 1 PromptUser = 2 End Enum Private Const STATUS_ABANDONED_WAIT_0 As Long = &H80 Private Const STATUS_WAIT_0 As Long = &H0 Private Const WAIT_ABANDONED As Long = (STATUS_ABANDONED_WAIT_0 + 0) Private Const WAIT_OBJECT_0 As Long = (STATUS_WAIT_0 + 0) Private Const WAIT_TIMEOUT As Long = 258& Private Const WAIT_FAILED As Long = &HFFFFFFFF Private Const WAIT_INFINITE = -1& Public Function ShellAndWait(ShellCommand As String, _ TimeOutMs As Long, _ ShellWindowState As VbAppWinStyle, _ BreakKey As ActionOnBreak) As ShellAndWaitResult ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' ShellAndWait ' ' This function calls Shell and passes to it the command text in ShellCommand. The function ' then waits for TimeOutMs (in milliseconds) to expire. ' ' Parameters: ' ShellCommand ' is the command text to pass to the Shell function. ' ' TimeOutMs ' is the number of milliseconds to wait for the shell'd program to wait. If the ' shell'd program terminates before TimeOutMs has expired, the function returns ' ShellAndWaitResult.Success = 0. If TimeOutMs expires before the shell'd program ' terminates, the return value is ShellAndWaitResult.TimeOut = 2. ' ' ShellWindowState ' is an item in VbAppWinStyle specifying the window state for the shell'd program. ' ' BreakKey ' is an item in ActionOnBreak indicating how to handle the application's cancel key ' (Ctrl Break). If BreakKey is ActionOnBreak.AbandonWait and the user cancels, the ' wait is abandoned and the result is ShellAndWaitResult.UserWaitAbandoned = 5. ' If BreakKey is ActionOnBreak.IgnoreBreak, the cancel key is ignored. If ' BreakKey is ActionOnBreak.PromptUser, the user is given a ?Continue? message. If the ' user selects "do not continue", the function returns ShellAndWaitResult.UserBreak = 6. ' If the user selects "continue", the wait is continued. ' ' Return values: ' ShellAndWaitResult.Success = 0 ' indicates the the process completed successfully. ' ShellAndWaitResult.Failure = 1 ' indicates that the Wait operation failed due to a Windows error. ' ShellAndWaitResult.TimeOut = 2 ' indicates that the TimeOutMs interval timed out the Wait. ' ShellAndWaitResult.InvalidParameter = 3 ' indicates that an invalid value was passed to the procedure. ' ShellAndWaitResult.SysWaitAbandoned = 4 ' indicates that the system abandoned the wait. ' ShellAndWaitResult.UserWaitAbandoned = 5 ' indicates that the user abandoned the wait via the cancel key (Ctrl+Break). ' This happens only if BreakKey is set to ActionOnBreak.AbandonWait. ' ShellAndWaitResult.UserBreak = 6 ' indicates that the user broke out of the wait after being prompted with ' a ?Continue message. This happens only if BreakKey is set to ' ActionOnBreak.PromptUser. ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Dim TaskID As Long Dim ProcHandle As Long Dim WaitRes As Long Dim Ms As Long Dim MsgRes As VbMsgBoxResult Dim SaveCancelKey As XlEnableCancelKey Dim ElapsedTime As Long Dim Quit As Boolean Const ERR_BREAK_KEY = 18 Const DEFAULT_POLL_INTERVAL = 500 If Trim(ShellCommand) = vbNullString Then ShellAndWait = ShellAndWaitResult.InvalidParameter Exit Function End If If TimeOutMs < 0 Then ShellAndWait = ShellAndWaitResult.InvalidParameter Exit Function ElseIf TimeOutMs = 0 Then Ms = WAIT_INFINITE Else Ms = TimeOutMs End If Select Case BreakKey Case AbandonWait, IgnoreBreak, PromptUser ' valid Case Else ShellAndWait = ShellAndWaitResult.InvalidParameter Exit Function End Select Select Case ShellWindowState Case vbHide, vbMaximizedFocus, vbMinimizedFocus, vbMinimizedNoFocus, vbNormalFocus, vbNormalNoFocus ' valid Case Else ShellAndWait = ShellAndWaitResult.InvalidParameter Exit Function End Select On Error Resume Next Err.Clear TaskID = Shell(ShellCommand, ShellWindowState) If (Err.Number <> 0) Or (TaskID = 0) Then ShellAndWait = ShellAndWaitResult.Failure Exit Function End If ProcHandle = OpenProcess(SYNCHRONIZE, False, TaskID) If ProcHandle = 0 Then ShellAndWait = ShellAndWaitResult.Failure Exit Function End If On Error GoTo ErrH: SaveCancelKey = Application.EnableCancelKey Application.EnableCancelKey = xlErrorHandler WaitRes = WaitForSingleObject(ProcHandle, DEFAULT_POLL_INTERVAL) Do Until WaitRes = WAIT_OBJECT_0 DoEvents Select Case WaitRes Case WAIT_ABANDONED ' Windows abandoned the wait ShellAndWait = ShellAndWaitResult.SysWaitAbandoned Exit Do Case WAIT_OBJECT_0 ' Successful completion ShellAndWait = ShellAndWaitResult.Success Exit Do Case WAIT_FAILED ' attach failed ShellAndWait = ShellAndWaitResult.Failure Exit Do Case WAIT_TIMEOUT ' Wait timed out. Here, this time out is on DEFAULT_POLL_INTERVAL. ' See if ElapsedTime is greater than the user specified wait ' time out. If we have exceed that, get out with a TimeOut status. ' Otherwise, reissue as wait and continue. ElapsedTime = ElapsedTime + DEFAULT_POLL_INTERVAL If Ms > 0 Then ' user specified timeout If ElapsedTime > Ms Then ShellAndWait = ShellAndWaitResult.TimeOut Exit Do Else ' user defined timeout has not expired. End If Else ' infinite wait -- do nothing End If ' reissue the Wait on ProcHandle WaitRes = WaitForSingleObject(ProcHandle, DEFAULT_POLL_INTERVAL) Case Else ' unknown result, assume failure ShellAndWait = ShellAndWaitResult.Failure Exit Do Quit = True End Select Loop CloseHandle ProcHandle Application.EnableCancelKey = SaveCancelKey Exit Function ErrH: Debug.Print "ErrH: Cancel: " & Application.EnableCancelKey If Err.Number = ERR_BREAK_KEY Then If BreakKey = ActionOnBreak.AbandonWait Then CloseHandle ProcHandle ShellAndWait = ShellAndWaitResult.UserWaitAbandoned Application.EnableCancelKey = SaveCancelKey Exit Function ElseIf BreakKey = ActionOnBreak.IgnoreBreak Then Err.Clear Resume ElseIf BreakKey = ActionOnBreak.PromptUser Then MsgRes = MsgBox("User Process Break." & vbCrLf & _ "Continue to wait?", vbYesNo) If MsgRes = vbNo Then CloseHandle ProcHandle ShellAndWait = ShellAndWaitResult.UserBreak Application.EnableCancelKey = SaveCancelKey Else Err.Clear Resume Next End If Else CloseHandle ProcHandle Application.EnableCancelKey = SaveCancelKey ShellAndWait = ShellAndWaitResult.Failure End If Else ' some other error. assume failure CloseHandle ProcHandle ShellAndWait = ShellAndWaitResult.Failure End If Application.EnableCancelKey = SaveCancelKey End Function
---------------------------------------------------------------------
This page is from http://www.cpearson.com/excel/ShellAndWait.aspx
No comments:
Post a Comment