Following is my solution for ShellAndWait which actually works, provides back to VBA the Exit Code of the called external program, AND allows the WindowStyle to be specified.
Example usage:
Note: If the command you wish to run is a command internal to cmd.exe, then you must submit the command via cmd.exe. This shall environment is "cmd'less" otherwise. Example:
Code:
Rem /************************************************************************************/
Rem /* FILENAME : modshared_shellandwait */
Rem /* TYPE : VBA Module */
Rem /* DESCRIPTION : VBA shared code which provides a Shell which Waits for the */
Rem /* called program to exit */
Rem /* */
Rem /* Code based on: */
Rem /* "How To Use a 32-Bit Application to Determine When a Shelled */
Rem /* Process Ends" */
Rem /* http://support.microsoft.com/kb/129796 */
Rem /* */
Rem /* Constants for WindowStyle arg found here: */
Rem /* http://office.microsoft.com/en-us/access-help/shell-function-HA001228906.aspx */
Rem /* vbHide */
Rem /* vbNormalFocus */
Rem /* vbMinimizedFocus */
Rem /* vbMaximizedFocus */
Rem /* vbNormalNoFocus */
Rem /* vbMinimizedNoFocus */
Rem /* */
Rem /* AUTHOR : Michael D Lueck */
Rem /* mlueck@lueckdatasystems.com */
Rem /* */
Rem /* NEEDS : */
Rem /* */
Rem /* USAGE : */
Rem /* */
Rem /* REVISION HISTORY */
Rem /* */
Rem /* DATE REVISED BY DESCRIPTION OF CHANGE */
Rem /* ---------- ---------- ------------------------------------------------------- */
Rem /* 10/11/2012 MDL Initial Creation */
Rem /************************************************************************************/
Option Compare Database
Option Explicit
Private Type STARTUPINFO
cb As Long
lpReserved As String
lpDesktop As String
lpTitle As String
dwX As Long
dwY As Long
dwXSize As Long
dwYSize As Long
dwXCountChars As Long
dwYCountChars As Long
dwFillAttribute As Long
dwFlags As Long
wShowWindow As Integer
cbReserved2 As Integer
lpReserved2 As Long
hStdInput As Long
hStdOutput As Long
hStdError As Long
End Type
Private Type PROCESS_INFORMATION
hProcess As Long
hThread As Long
dwProcessID As Long
dwThreadID As Long
End Type
Private Declare Function CreateProcessA Lib "kernel32" _
(ByVal pApplicationName As String, _
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 String, _
lpStartupInfo As STARTUPINFO, _
lpProcessInformation As PROCESS_INFORMATION) As Long
Private Declare Function WaitForSingleObject Lib "kernel32" _
(ByVal hHandle As Long, _
ByVal dwMilliseconds As Long) As Long
Private Declare Function GetExitCodeProcess Lib "kernel32" _
(ByVal hProcess As Long, lpExitCode As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" _
(ByVal hObject As Long) As Long
Private Const STARTF_USESHOWWINDOW& = &H1
Private Const NORMAL_PRIORITY_CLASS = &H20&
Private Const INFINITE = -1&
Public Function shellandwait_ShellWait(ByVal strCMDLine As String, Optional ByVal lnWindowStyle As Long = vbNormalFocus) As Long
On Error GoTo Err_shellandwait_ShellWait
Dim start As STARTUPINFO
Dim proc As PROCESS_INFORMATION
Dim lnRC As Long
'Initialize the STARTUPINFO structure:
With start
.cb = Len(start)
.dwFlags = STARTF_USESHOWWINDOW
.wShowWindow = lnWindowStyle
End With
'Start the shelled application:
lnRC = CreateProcessA(vbNullString, strCMDLine, 0&, 0&, 1&, _
NORMAL_PRIORITY_CLASS, 0&, vbNullString, start, proc)
'Wait for the shelled application to finish:
lnRC = WaitForSingleObject(proc.hProcess, INFINITE)
Call GetExitCodeProcess(proc.hProcess, lnRC)
Call CloseHandle(proc.hThread)
Call CloseHandle(proc.hProcess)
'Return the PID's Exit Code
shellandwait_ShellWait = lnRC
Exit_shellandwait_ShellWait:
Exit Function
Err_shellandwait_ShellWait:
Call errorhandler_MsgBox("Module: modshared_shellandwait, Function: shellandwait_ShellWait()")
shellandwait_ShellWait = 1
Resume Exit_shellandwait_ShellWait
End Function
Code:
lnRC = shellandwait_ShellWait(strCMDLine, vbMinimizedNoFocus)
Code:
'Build the command line to be executed
'Define a variable so we may use the DoubleQuote character as we build the command line string to be executed
strDoubleQuote = Chr(34)
strCMDLine = "cmd.exe /c RD /s/q " & strDoubleQuote & strDestDir & strDoubleQuote
'Execute the command line
lngRC = shellandwait_ShellWait(strCMDLine, vbMinimizedNoFocus)
Last edited:
