Running a program from Excel Basic and waiting for the results

I haven't used Excel Basic in a while, so I don't know if this code is still useful.  The last version of Excel I used did not allow you to run a program and wait for it to finish:  it only had the Shell command, which returned immediately.  The code below will allow you to run another program and wait for the results.  It uses functions in the Windows API (not .NET functions) to accomplish this.

Attribute VB_Name = "RW_App"
'Code Module:         RW_App.base
'Author:              David J Strumfels
'Last Revision:       1/1/00
'
'This module contains the function RunWaitApp, which is basically a version of the
'VB Shell() command, in which the calling program waits for the shelled program to
'complete before returning.  In addition to the same lpCommandLine and
'wShowWindow arguments that Shell() takes, RunWaitApp also takes the boolean
'argument bWait, which determines whether the calling program will continue to have
'its events processed while lpCommandLine executes.  If bWait is False, the caller
'has events processed; if bWait is True and lWaitTime is a sufficiently large number,
'the caller is completely suspended, with no event processing at all.

'This is a little confusing, so NOTE:  RunWaitApp ALWAYS waits for lpCommandLine to
'complete before returning.  All that bWait does is determine whether caller events
'are always processed or not; that is, whether any caller windows are repainted,
'moved, or resized, or menu selections processed, or any other event-driven actions
'associated with the caller are processed.  If bWait is False, then the caller's
'events are always processed.  If bWait is True, then what happens depends on the
'value of lWaitTime:  if lWaitTime is very large -- essentially infinite -- the
'caller is completely frozen; if lWaitTime = 0, then this is equivalent to calling
'the function with bWait = False.

Option Explicit

Private Type PROCESS_INFORMATION
    hProcess As Long
    hThread As Long
    dwProcessId As Long
    dwThread As Long
End Type

Private Type STARTUPINFO
    cb As Long
    lpReserved As String
    lpDesktop 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 Long
    lpReserved2 As Long
    hStdInput As Long
    hStdOutput As Long
    hStdError As Long
End Type

Declare Function CreateProcess Lib "Kernel32" Alias "CreateProcessA" _
                                 (ByVal lpApplicationName As String, _
                                  ByVal lpCommandLine As String, _
                                  ByVal lpProcessAttributes As Long, _
                                  ByVal lpThreadAttributes As Long, _
                                  ByVal bInheritHandles As Long, _
                                  ByVal dwCreationFlags As Long, _
                                  lpEnvironment As Any, _
                                  ByVal lpCurrentDirectory As String, _
                                  lpStartupInfo As STARTUPINFO, _
                                  lpProcessInformation As PROCESS_INFORMATION) As Long

Private Declare Function CloseHandle Lib "Kernel32" (ByVal hObject As Long) As Long

Private Declare Function WaitForSingleObject Lib "Kernel32" _
                                  (ByVal hHandle As Long, _
                                   ByVal dwMilliseconds As Long) As Long
                                  
Declare Function FindExecutable Lib "Shell32.dll" Alias "FindExecutableA" _
                                  (ByVal lpFile As String, _
                                   ByVal lpDirectory As String, _
                                   ByVal lpResult As String) As Long
                                  
Function ShellWaitApp(lpFile As String, _
                      lpParameters As String, _
                      wShowWindow As Integer, _
                      bWait As Boolean, Optional lWaitTime As Long) As Boolean

  Dim lpResult As String * 255, lpCommandLine As String
  Dim res As Long
 
  res = FindExecutable(lpFile, CurDir, lpResult)
 
  If res <> 0 Then
    lpCommandLine = Left(lpResult, InStr(lpResult, Chr(0)) - 1) & " " & lpFile & " " & lpParameters
   
    If RunWaitApp(lpCommandLine, wShowWindow, bWait, lWaitTime) Then
      ShellWaitApp = True
    Else
      ShellWaitApp = False
    End If
     
  Else
    ShellWaitApp = False
  End If
 
End Function

Function RunWaitApp(lpCommandLine As String, _
                    wShowWindow As Integer, _
                    bWait As Boolean, Optional lWaitTime As Long) As Boolean
   
  Dim sinfo As STARTUPINFO
  Dim pinfo As PROCESS_INFORMATION
  Dim res As Long
  Dim lWait As Long

  If bWait Then
    lWait = lWaitTime
  Else
    Shell lpCommandLine, wShowWindow
    RunWaitApp = True
    Exit Function
  End If


  sinfo.cb = Len(sinfo)
  sinfo.wShowWindow = wShowWindow

  res = CreateProcess(vbNullString, _
                      lpCommandLine, _
                      0, 0, True, &H20, ByVal 0&, _
                      vbNullString, sinfo, pinfo)
                     
  If res <> 0 Then
 
    Do
      res = WaitForSingleObject(pinfo.hProcess, lWait)
     
      If res <> &H102& Then
        Exit Do
      End If

      DoEvents
    Loop While True
   
    CloseHandle pinfo.hProcess
    RunWaitApp = True
  Else
    RunWaitApp = False
  End If
 
End Function