Public Declare Function OpenProcess Lib "kernel32" ( _ 
ByVal dwDesiredAccess As Long, _  
ByVal bInheritHandle As Long,  - 
ByVal dwProcessId As Long) As Long
 
Public Declare Function GetExitCodeProcess Lib "kernel32" ( _ 
ByVal hProcess As Long,  _ 
lpExitCode As Long) As Long
 
Public Const STATUS_PENDING = &H103&
 
Public Const PROCESS_QUERY_INFORMATION = &H400
 
Public Enum ShellWindowStyle
    Hidden = 0
    NormalFocus = 1
    MinimizedFocus = 2
    MaximizedFocus = 3
    NormalNoFocus = 4
    MinimizedNoFocus = 6
End Enum

Public Function ShellAndWait(ByVal sExeName As String,  _ 
Optional ByVal params As String, Optional TimeOutValue As Long = 0,  - 
Optional SetWindowStyle As ShellWindowStyle = vbNormalFocus) As Long
 
    Dim lInst As Long
    Dim lStart As Long
    Dim lTimeToQuit As Long
    Dim lProcessId As Long
    Dim lExitCode As Long
    Dim bPastMidnight As Boolean
 
    On Error GoTo ErrHandler
 
    lStart = CLng(Timer)
 
    'Deal with timeout being reset at Midnight
    If TimeOutValue > 0 Then
        If lStart + TimeOutValue < 86400 Then
            lTimeToQuit = lStart + TimeOutValue
        Else
            lTimeToQuit = (lStart - 86400) + TimeOutValue
            bPastMidnight = True
        End If
    End If
 
    lInst = Shell(sExeName & " " & params, SetWindowStyle)
    lProcessId = OpenProcess(PROCESS_QUERY_INFORMATION, False, lInst)
 
    Do
        GetExitCodeProcess lProcessId, lExitCode
        DoEvents
        If TimeOutValue And Timer > lTimeToQuit Then
            If bPastMidnight Then
                If Timer < lStart Then Exit Do
            Else
                Exit Do
            End If
        End If
    Loop While lExitCode = STATUS_PENDING
 
    ShellAndWait = lExitCode
 
Escape:
    Exit Function
ErrHandler:
'Fehlerbehandlung hier:
    Resume Escape
End Function