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
A Medley of Potpourri is just what it says; various thoughts, opinions, ruminations, and contemplations on a variety of subjects.
Search This Blog
Lie group
From Wikipedia, the free encyclopedia https://en.wikipedia.org/wiki/Lie_group In mathematics , a Lie gro...
-
From Wikipedia, the free encyclopedia Islamic State of Iraq and the Levant الدولة الإسلامية في العراق والشام ( ...
-
From Wikipedia, the free encyclopedia A reproduction of the palm -leaf manuscript in Siddham script ...