trjhtr

I stumbled across this post on SO, and it had a link to some good code; however the code itself was a bit dated. Since the code has a "do not modify" clause I went back to the basics as noted by the urls in the comments and rebuilt it from the ground up using more or less the same style, except making it 64-bit friendly and exposing more of the API functionality.

Module Code: WinShellAPI

Option Explicit

'Syntatic sugar
Private Const QO As String = """"
Private Const SP As String = " "
Private Const NL As String = vbNewLine
Private Const NS As String = vbNullString 'reduces length, but also legibility

Private Const STARTF_USESHOWWINDOW As Long = &H1 'Windows constant see STARTUPINFO API linked below
'Private Const NORMAL_PRIORITY_CLASS = &H20&

'Wait time intervals are in milliseconds
Private Const ONE_MINUTE As Long = 1000& * 60&
Private Const FIVE_MINUTES As Long = ONE_MINUTE * 5&
Private Const INFINITE As Long = -1& 'Not recomended

Private Const WAIT_TIMEOUT As Long = 102& 'The time-out interval elapsed, and the object's state is nonsignaled.

Private Const CPP_NULL As Long = 0&
Private Const CPP_TRUE As Long = 1&
Private Const CPP_FALSE As Long = 0&

'This one is not really implemented, it can be combined with BasePriority using bitwise_or
'https://msdn.microsoft.com/en-us/library/windows/desktop/ms684863(v=vs.85).aspx
Public Enum ProcessCreationFlags
 CREATE_BREAKAWAY_FROM_JOB = &H1000000
 CREATE_DEFAULT_ERROR_MODE = &H4000000
 CREATE_NEW_CONSOLE = &H10&
 CREATE_NEW_PROCESS_GROUP = &H200&
 CREATE_NO_WINDOW = &H8000000
 CREATE_PROTECTED_PROCESS = &H40000
 CREATE_PRESERVE_CODE_AUTHZ_LEVEL = &H2000000
 CREATE_SECURE_PROCESS = &H400000
 CREATE_SEPARATE_WOW_VDM = &H800&
 CREATE_SHARED_WOW_VDM = &H1000&
 CREATE_SUSPENDED = &H4&
 CREATE_UNICODE_ENVIRONMENT = &H400&
 DEBUG_ONLY_THIS_PROCESS = &H2&
 DEBUG_PROCESS = &H1&
 DETACHED_PROCESS = &H8&
 EXTENDED_STARTUPINFO_PRESENT = &H80000
 INHERIT_PARENT_AFFINITY = &H10000
End Enum
'https://msdn.microsoft.com/en-us/library/windows/desktop/ms683211(v=vs.85).aspx
Public Enum ProcessPriorityClass
 REALTIME_PRIORITY_CLASS = &H100&
 HIGH_PRIORITY_CLASS = &H80&
 ABOVE_NORMAL_PRIORITY_CLASS = &H8000&
 NORMAL_PRIORITY_CLASS = &H20&
 BELOW_NORMAL_PRIORITY_CLASS = &H4000&
 IDLE_PRIORITY_CLASS = &H40&
End Enum

'Compatible with VbAppWinStyle, so I used that instead
'https://msdn.microsoft.com/en-us/library/windows/desktop/ms633548(v=vs.85).aspx
'Public Enum nCmdShow
' SW_HIDE = 0 'Hides the window and activates another window.
' SW_SHOWNORMAL 'Activates and displays a window. If the window is minimized or maximized, the system restores it to its original size and position. An application should specify this flag when displaying the window for the first time.
' SW_SHOWMINIMIZED 'Activates the window and displays it as a minimized window.
' SW_MAXIMIZE 'Maximizes the specified window.
' SW_SHOWMAXIMIZED = 3 'Activates the window and displays it as a maximized window.
' SW_SHOWNOACTIVATE 'Displays a window in its most recent size and position. This value is similar to SW_SHOWNORMAL, except that the window is not activated.
' SW_SHOW 'Activates the window and displays it in its current size and position.
' SW_MINIMIZE 'Minimizes the specified window and activates the next top-level window in the Z order.
' SW_SHOWMINONACTIVE 'Displays the window as a minimized window. This value is similar to SW_SHOWMINIMIZED, except the window is not activated.
' SW_SHOWNA 'Displays the window in its current size and position. This value is similar to SW_SHOW, except that the window is not activated.
' SW_RESTORE 'Activates and displays the window. If the window is minimized or maximized, the system restores it to its original size and position. An application should specify this flag when restoring a minimized window.
' SW_SHOWDEFAULT 'Sets the show state based on the SW_ value specified in the STARTUPINFO structure passed to the CreateProcess function by the program that started the application.
' SW_FORCEMINIMIZE 'Minimizes a window, even if the thread that owns the window is not responding. This flag should only be used when minimizing windows from a different thread.
'End Enum

'https://msdn.microsoft.com/en-us/library/windows/desktop/aa379560(v=vs.85).aspx
'not implemented, i just used CPP_NULL for lpProcessAttributes and lpThreadAttributes
'Private Type SECURITY_ATTRIBUTES
' dwLength As Long
' lpSecurityDescriptor As LongPtr
' bInheritHandle As Long
'End Type

'https://msdn.microsoft.com/en-us/library/windows/desktop/ms686331(v=vs.85).aspx
Private Type STARTUPINFO
 cb As Long 'The size of the structure in bytes
 lpReserved As String 'Reserved; must be CPP_NULL
 lpDesktop As String 'The name of the desktop, or the name of both the desktop and window station for this process.
 lpTitle As String 'For console processs, this is the title displayed in the title bar if a new console window is created.
 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 'Reserved for use by the C Run-time; must be zero.
 lpReserved2 As LongPtr 'Reserved for use by the C Run-time; must be NULL.
 hStdInput As LongPtr
 hStdOutput As LongPtr
 hStdError As LongPtr
End Type

'https://msdn.microsoft.com/en-us/library/windows/desktop/ms684873(v=vs.85).aspx
'If the function succeeds, be sure to call the CloseHandle function to close the hProcess and hThread handles when you are finished with them. Otherwise, when the child process exits, the system cannot clean up the process structures for the child process because the parent process still has open handles to the child process. However, the system will close these handles when the parent process terminates, so the structures related to the child process object would be cleaned up at this point.
Private Type PROCESS_INFORMATION
 hProcess As LongPtr 'A handle to the newly created process. The handle is used to specify the process in all functions that perform operations on the process object.
 hThread As LongPtr 'A handle to the primary thread of the newly created process. The handle is used to specify the thread in all functions that perform operations on the thread object.
 dwProcessID As Long 'A value that can be used to identify a process. The value is valid from the time the process is created until all handles to the process are closed and the process object is freed; at this point, the identifier may be reused.
 dwThreadID As Long 'A value that can be used to identify a thread. The value is valid from the time the thread is created until all handles to the thread are closed and the thread object is freed; at this point, the identifier may be reused.
End Type

'https://msdn.microsoft.com/en-us/library/windows/desktop/ms682425(v=vs.85).aspx
'lpApplicationName 'The function will not use the search path. This parameter must include the file name extension; no default extension is assumed.
'lpCommandLine 'If the file name does not contain a directory path, the system searches for the executable file
Private Declare PtrSafe Function WinAPI_CreateProcess Lib "kernel32" Alias "CreateProcessA" _
 (ByVal lpApplicationName As String, ByVal lpCommandLine As String, _
 ByVal lpProcessAttributes As LongPtr, ByVal lpThreadAttributes As LongPtr, _
 ByVal bInheritHandles As Long, ByVal dwCreationFlags As ProcessPriorityClass, _
 ByVal lpEnvironment As String, ByVal lpCurrentDirectory As String, _
 lpStartupInfo As STARTUPINFO, lpProcessInformation As PROCESS_INFORMATION) As Long

'https://msdn.microsoft.com/en-us/library/windows/desktop/ms687032(v=vs.85).aspx
Private Declare PtrSafe Function WinAPI_WaitForSingleObject Lib "kernel32" Alias "WaitForSingleObject" _
 (ByVal hHandle As LongPtr, ByVal dwMilliseconds As Long) As Long

'https://msdn.microsoft.com/en-us/library/windows/desktop/ms724211(v=vs.85).aspx
Private Declare PtrSafe Function WinAPI_CloseHandle Lib "kernel32" Alias "CloseHandle" (ByVal _
 hObject As LongPtr) As Long

'comment and uncomment as needed for each Offic App you're using
Private Function DefaultPath() As String
 DefaultPath = CurrentProject.Path 'MS-Access
' DefaultPath = IIf(Application.ActiveWorkbook.Path = "", Application.Path, Application.ActiveWorkbook.Path) 'MS-Excel
' DefaultPath = IIf(Application.ActiveDocument.Path = "", Application.Path, Application.ActiveDocument.Path) 'MS-Word
' DefaultPath = Environ("temp") 'Windows Tmp
' DefaultPath = Environ("appdata") 'Windows Application data
' DefaultPath = "c:your custompath" 'Manual entry
End Function

Private Function Quote(s As String, Optional q As String = QO) As String: Quote = q & s & q: End Function

Private Function WaitOnProc(Proc As PROCESS_INFORMATION, ByVal WaitCycles As Long, ByVal WaitInterval As Long) As Long
 If WaitCycles < 0 Then WaitCycles = -WaitCycles
 Do
 WaitOnProc = WinAPI_WaitForSingleObject(Proc.hProcess, FIVE_MINUTES)
 WaitCycles = WaitCycles - 1
 DoEvents
 Loop While WaitCycles > 0 And WaitOnProc = WAIT_TIMEOUT
End Function

'ToDo - find a better name than Shell64, since the current Shell() does work in 64-bit
Public Sub Shell64( _
 Optional ByVal CmdLine As String = NS, Optional WindowStyle As VbAppWinStyle = -1, Optional ByVal StartIn As String = NS, _
 Optional WaitForExit As Boolean = False, Optional WaitCycles, Optional WaitInterval As Long = FIVE_MINUTES, _
 Optional BasePriority As ProcessPriorityClass = NORMAL_PRIORITY_CLASS, Optional ByVal EnvConsts As String = NS, _
 Optional ByVal AppName As String = NS)

 If StrPtr(AppName) = 0 And StrPtr(CmdLine) = 0 Then Exit Sub

 If StrPtr(StartIn) = 0 Then StartIn = DefaultPath()

 'Expand %PathVariables%
 If StrPtr(AppName) <> 0 Then
 Dim at As Long, s As String
 at = InStr(AppName, "%") + 1
 Do While at > 1
 s = Mid(AppName, at, InStr(at, AppName, "%") - at)
 AppName = Replace(AppName, Quote(s, "%"), Environ(s))
 at = InStr(AppName, "%") + 1
 Loop
 End If

 ' Initialize STARTUPINFO
 Dim StartInfo As STARTUPINFO
 StartInfo.cb = Len(StartInfo)
 If WindowStyle <> -1 Then
 StartInfo.dwFlags = STARTF_USESHOWWINDOW
 StartInfo.wShowWindow = CInt(WindowStyle)
 End If

 ' Start the application
 Dim r As Long, MyProc As PROCESS_INFORMATION
 r = WinAPI_CreateProcess( _
 lpApplicationName:=AppName, _
 lpCommandLine:=CmdLine, _
 lpProcessAttributes:=CPP_NULL, _
 lpThreadAttributes:=CPP_NULL, _
 bInheritHandles:=CPP_TRUE, _
 dwCreationFlags:=BasePriority, _
 lpEnvironment:=EnvConsts, _
 lpCurrentDirectory:=StartIn, _
 lpStartupInfo:=StartInfo, _
 lpProcessInformation:=MyProc _
 )

 ' Wait for the application to finish
 If r <> CPP_FALSE Then
 If WaitForExit Then
 If IsMissing(WaitCycles) Then
 Do: r = WaitOnProc(MyProc, 0, WaitInterval): Loop Until r <> WAIT_TIMEOUT
 Else
 WaitOnProc MyProc, WaitCycles, WaitInterval
 End If
 End If
 'clean up
 r = WinAPI_CloseHandle(MyProc.hProcess)
 r = WinAPI_CloseHandle(MyProc.hThread)
 End If
End Sub

Private Sub ShellWait_test()
 'Tested on: Windows 7 64-Bit, MS-Access 2013 64-Bit, $PSVersionTable.PSVersion 5.1.14409.1012

 Dim MyEnvVars As String: MyEnvVars = _
 "ENV_VAR1=HI" & vbNullChar & _
 "ENV_VAR2=BYE" & vbNullChar

 ShellWait "cmd /k set", vbNormalFocus, "C:Windows", 6, ONE_MINUTE, ABOVE_NORMAL_PRIORITY_CLASS, MyEnvVars
 ShellWait "-c ""& date;pause""", vbNormalFocus, , , , , , "%SystemRoot%system32WindowsPowerShellv1.0powershell.exe"
End Sub
'EnvConsts is a "null-terminated block of null-terminated strings", yes the last one has two null-terminations (vbNullChar & vbNullChar) for Char, and (vbNullChar & vbNullChar & vbNullChar & vbNullChar) for CharW
'EnvConsts example:
' "HOMEDRIVE=H:" & vbNullChar & "HOMEPATH=" & vbNullChar
Public Sub ShellWait( _
 Optional ByVal CmdLine As String = NS, Optional WindowStyle As VbAppWinStyle = -1, Optional ByVal StartIn As String = NS, _
 Optional WaitCycles, Optional WaitInterval As Long = FIVE_MINUTES, _
 Optional BasePriority As ProcessPriorityClass = NORMAL_PRIORITY_CLASS, Optional ByVal EnvConsts As String = NS, _
 Optional ByVal AppName As String = NS)
 If IsMissing(WaitCycles) Then
 Shell64 CmdLine, WindowStyle, StartIn, True, , WaitInterval, BasePriority, EnvConsts, AppName
 Else
 Shell64 CmdLine, WindowStyle, StartIn, True, WaitCycles, WaitInterval, BasePriority, EnvConsts, AppName
 End If
End Sub

Private Sub PowerShell_test()
 'Tested on: Windows 7 64-Bit, MS-Access 2013 64-Bit, $PSVersionTable.PSVersion 5.1.14409.1012
 PowerShell ShellCmd:="date;pause", WaitForExit:=True

 Dim StartInPath As String: StartInPath = "\MyNetworkShareCodePowerShell"
 PowerShell ScriptFile:="hello.ps1", Parameters:="-wait", StartIn:=StartInPath, WindowStyle:=vbNormalFocus

 Dim Params As Variant: Params = Array( _
 Array("pName1", "pValue1") _
 , Array("pName2", "pValue2 with spaces") _
 , Array("switch1", "") _
 , Array("switch2", vbNullString) _
 , Array("wait", vbNullString) _
 )
 PowerShell ScriptFile:="hello.ps1", Parameters:=Params, StartIn:=StartInPath, WindowStyle:=vbNormalFocus

' #hello.ps1
' param([alias('Blocking')][switch]$Wait)
' write-host "hello world"
' if($wait)pause;
End Sub
Public Sub PowerShell( _
 Optional ShellCmd As String = NS, Optional WindowStyle As VbAppWinStyle = -1, Optional StartIn As String = NS, _
 Optional Parameters, Optional ScriptFile As String = NS, _
 Optional WaitForExit As Boolean = False, Optional WaitCycles, Optional WaitInterval As Long = FIVE_MINUTES, _
 Optional BasePriority As ProcessPriorityClass = NORMAL_PRIORITY_CLASS)
 'implementation decision: require one or the other of either ShellCmd or ScriptFile, but not both
 If Not (StrPtr(ShellCmd) = 0 Xor StrPtr(ScriptFile) = 0) Then Exit Sub

 'The Command/Script's parameters are passed in as a commandline string or two dim name,value array
 Dim Params As String
 If Not IsMissing(Parameters) Then
 Select Case TypeName(Parameters)
 Case "String"
 'passed in as a string
 Params = SP & Trim(Parameters)
 Case "Variant()"
 If IsArray(Parameters) Then
 'passed in as a two dim array of nams,values
 Dim i As Long, j As Long, pVal As String
 For i = LBound(Parameters) To UBound(Parameters)
 j = LBound(Parameters(i))
 Params = Params & SP & "-" & Parameters(i)(j)
 pVal = Parameters(i)(j + 1)
 'note pVal:=vbNullString, gives same results because it's internally converted to "" for the comparison
 If pVal <> "" Then Params = Params & SP & WrapToken(pVal) 'Parameter has a value
 Next i
 End If
 'Otherwise Variant but not String and not Array => ignore parameters
 Case Else 'ToDo - Not implemented, just skipped parameters
 End Select
 End If

 Dim PSpath As String, CmdLine As String
 If StrPtr(ScriptFile) <> 0 Then
 'Run a PowerShell Script
 PSpath = NS
 CmdLine = "powershell -ex unrestricted -f " & WrapToken(ScriptFile) & Params
 Else
 'Run a PowerShell Command
 PSpath = Environ("SystemRoot") & "system32WindowsPowerShellv1.0powershell.exe"
 CmdLine = "-c " & Quote("& " & ShellCmd & Params & "")
 End If

 ' Start PowerShell
 If IsMissing(WaitCycles) Then
 Shell64 CmdLine, WindowStyle, StartIn, WaitForExit, , WaitInterval, BasePriority, NS, PSpath
 Else
 Shell64 CmdLine, WindowStyle, StartIn, WaitForExit, WaitCycles, WaitInterval, BasePriority, NS, PSpath
 End If
End Sub

'used to wrap commandline tokens with quotes as needed
Private Function WrapToken(Token As String) As String
 Dim rChar As String: rChar = Chr(26) 'a character not likely to be in a command line string ''
 WrapToken = Token
 If InStr(WrapToken, SP) > 0 Or InStr(WrapToken, QO) > 0 Then
 'token contains a space or double quote character so it needs wrapped
 'For Example pVal = my string \"hello"
 WrapToken = Replace(WrapToken, "\", rChar & rChar) ' my string ~~"hello"
 WrapToken = Replace(WrapToken, "" & QO, QO) ' my string ~~"hello"
 WrapToken = Replace(WrapToken, QO, "" & QO) ' my string ~~"hello"
 WrapToken = Replace(WrapToken, rChar & rChar, "\") ' my string \"hello"
 WrapToken = Quote(WrapToken) ' "my string \"hello""
 End If
End Function

Edit: looking for feedback, especially compatibility issues. (Besides on non-Windows computers, of course)

Edit2 - Add a blurb: The original code linked in the opening paragraph extended VBA's built in toolset with a ShellWait() sub similar to the built in Shell() function except that it was a blocking system call so that the execution of the VBA code would stop and wait for ShellWait() to complete before it moves on to the next line of VBA code. By adding the blocking feature this allows you to write VBA that calls external programs and know that they've finished creating files, sending files, ... or what ever the external program needs to get done, before the VBA moves on and tries to use the results from that external program before they've been created. Their code I believe still works in 32-bit Access, however I'm running 64-bit so for that reason alone I needed a revision. In reviewing the code I came across a couple "bugs"; I'm not too sure if they were bugs at the time the original code was written but they are today so maybe the term "temporal-bugs" is better suited. Anyhow I fixed the two bugs(calling IsMissing(Long) and not calling CloseHandle(Proc.hThread)), and kept going from there. I added DefaultPath() so that you should be able to reuse the same code in Excel, Word, Outlook, ... and I think possibly the whole Office Suite(I would have preferred a constant if I could have gotten away with it). I moved the Shell part out to its own Shell64() so you can have a sub where blocking is optional yet still has all the additional exposed API as the strictly blocking ShellWait() version. Then because I run PowerShell stuff often enough I added PowerShell() with the same features to optionally run a command line string or a script file.

Looking at Shell64() and ShellWait()

• 
  CmdLine, WindowStyle: should be analogous with Shell(PathName,WindowStyle) and would work as a straight replacement except that Shell64() doesn't return the ThreadID(IMO I'm not too sure ThreadID is useful for anything, probably better off returning MyProc from Shell64()).


• 
  StartIn: is a nice API feature so that the first line of my batch file doesn't have to relocate itself and I've defaulted it in the VBA to be the same folder as the database/spreadsheet file the Module is saved in.


• 
  WaitForExit, WaitCycles, and WaitInterval: are all related to the blocking. WaitForExit turns blocking on/off, WaitCycles is the number of timeout cycles to wait(at least one) before moving on(indefinite if omitted), WaitInterval is the milliseconds used to set the timeout between cycles(does a DoEvents between cycles so that excel/access doesn't think the executable is frozen and to allow for user ctrl-break).


• 
  BasePriority: probably not used that often but allows you to change the task's execution priority on the CPU(realtime not recommended).


• 
  EnvConsts: also not likely to be used much since explicitly setting these clears out all the default ones. (open command prompt and use the set command to see your defaults)


• 
  AppName: this one is a bit harder to use, when present it needs to be a fully qualified path to the executable(I've also implemented %% expansion as seen on the command line in the VBA code so that should work too)

Looking at PowerShell()

• 
  ShellCmd, WindowStyle, StartIn: same as Shell64 except run under PowerShell instead of cmd(and definitely not cmd /c powershell).


• 
  Parameters: makes it easy to split off parameters passed to the command or script. Can be a single line as given on the command line, or a two dimensional variant array kinda like a dictionary"parameter name", "parameter value".


• 
  WaitForExit, WaitCycles, WaitInterval same blocking functionality used in Shell64
  


• 
  BasePriority: same process elevation as Shell64