Hallo!
Ich hab folgendes Problem: Ich möchte mit VBA (Excel) ein Programm starten und auf dessen Beendigung warten. Erst dann soll der VBA-Code weiter ausgeführt werden. Nun hab ich schon einiges probiert, aber es klappt noch nicht... Ich kann mit ShellExec das Programm starten, aber dann wartet VBA nicht...
Mit folgendem Aufruf startet das Programm und es wird auch gewartet, aber eben nur die vorgegebene Zeit.
ShellModul.ShellExec frmKmw.Speicherort + "\" + frmKmw.InputdateiName + ".inp"
newHour = Hour(Now())
newMinute = Minute(Now()) + 15
newSecond = Second(Now())
waitTime = TimeSerial(newHour, newMinute, newSecond)
Application.Wait waitTime
Da aber das ausgeführte Programm nicht immer nach der selben Zeit fertig ist, und ich vorher auch nicht weiß, wie lange es dauern wird, möchte ich eine Lösung finden, die solange wartet, bis das Programm auch wirklich beendet ist.
Hab mir daraufhin folgenden Code aus dem Internet zusammengebastellt.
Private Declare Function ShellExecuteA Lib "shell32.dll" ( _
ByVal hwnd As Long, ByVal lpOperation As String, _
ByVal lpFile As String, ByVal lpParameters As String, _
ByVal lpDirectory As String, ByVal nShowCmd As Long _
) As Long
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, _
ByVal hProg As Long, _
ByVal idProg As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Declare Function WaitForSingleObject Lib "kernel32" _
(ByVal hHandle As Long, ByVal dwMilliseconds As Long) _
As Long
Private Declare Function GetExitCodeProcess Lib "kernel32" _
(ByVal hProg As Long, iExit As Long) As Long
Function ShellExec( _
ByVal Path As String, _
Optional ByVal WindowStyle As VbAppWinStyle = vbNormalFocus, _
Optional ByVal Operation As String = "open" _
) As Boolean
ShellExec = ( _
ShellExecuteA(0&, Operation, Path, _
vbNullString, vbNullString, WindowStyle) > 32)
End Function
Function WaitOnProgram(ByVal idProg As Long, _
Optional ByVal WaitDead As Boolean) As Long
Dim cRead As Long, iExit As Long, hProg As Long
hProg = OpenProcess(PROCESS_ALL_ACCESS, True, idProg)
If (WaitDead = True) Then
Dim iResult As Long
iResult = WaitForSingleObject(hProg, INFINITE)
If iResult = WAIT_FAILED Then Err.Raise Err.LastDllError
GetExitCodeProcess hProg, iExit
Else
GetExitCodeProcess hProg, iExit
Do While iExit = STILL_ACTIVE
DoEvents
GetExitCodeProcess hProg, iExit
Loop
End If
CloseHandle hProg
WaitOnProgram = iExit
End Function
Und so wird es aufgerufen:
Dim idProg As Long, iExit As Long
idProg = ShellModul.ShellExec(frmKmw.Speicherort + "\" + frmKmw.InputdateiName + ".inp")
iExit = ShellModul.WaitOnProgram(idProg)
If iExit Then MsgBox "Compile failed"
PROBLEM: VBA bleibt an der Stelle DoEvents stehen... |