none
RÜckgabecodes von Kommandozeilenprogrammen auswerten ...

    Frage

  • Ich benutze folgenden Code um ein externes Programm aus einer VBA-Routine aufzurufen:

    dummy = Modul1.ShellAndWait("open", "C:\Program Files\SimulatedDreams\SetGutachtenPublicAppt.exe ", parxyz, Normal, _
           Termination, 15000, True)


    Public Function ShellAndWait(ByVal Operation As String, _
                                 ByVal FilePath As String, _
                                 Optional Parameter As String, _
                                 Optional WorkingFolder As String, _
                                 Optional WindowSize As ShowConstants = 1, _
                                 Optional WaitFor As WaitConstants = 0, _
                                 Optional Milliseconds As Long = -1, _
                                 Optional CloseProcess As Boolean = False) As String
     
       Dim Retval As Long
       Dim ShExInfo As SHELLEXECUTEINFO
    
       '//////////////////////////////////////////////////////////////////////////////
        ' Initialisierung
       '\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
     
       If WorkingFolder = "" Then WorkingFolder = FilePath
    
       With ShExInfo
          .cbSize = Len(ShExInfo)
          .fMask = SEE_MASK_NOCLOSEPROCESS
          .Hwnd = 0
          .lpVerb = Operation
          .lpFile = Trim(FilePath)
          .lpParameters = Parameter
          .lpDirectory = WorkingFolder
          .nShow = WindowSize
       End With
    
    
       '/////////////////////////////////////////////////////////////////////////////
        ' Anwendung ausführen
       '\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
     
       Retval = ShellExecuteEx(ShExInfo)
    
       If Retval = 0 Then
           'Ein Fehler ist aufgetreten
           ShellAndWait = ShellExecError(ShExInfo.hInstApp)
           Exit Function
       End If
    
    
       '/////////////////////////////////////////////////////////////////////////////
        ' Warten auf Prozess
       '\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
     
       If WaitFor <> None Then
    
          If WaitFor = Initialisiert Then
             ' Warten bis die Anwendung initialisiert ist
             Retval = WaitForInputIdle(ShExInfo.hProcess, Milliseconds)
    
          Else
             ' Warten bis die Anwendung beendet
             Retval = WaitForSingleObject(ShExInfo.hProcess, Milliseconds)
    
          End If
    
          If Retval = WAIT_FAILED Then ShellAndWait = "Warten auf Prozess fehlgeschlagen."
     
       End If
    
       '/////////////////////////////////////////////////////////////////////////////
        ' SCHLIEßEN DES PROZESSES
       '\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
        If CloseProcess = True Then
          Retval = TerminateProcess(ShExInfo.hProcess, 1)
          If Retval <> 0 Then ShellAndWait = "Schließen der Anwendung fehlgeschlagen."
        End If
    
    End Function

    Der ode stammt nicht von mir und macht eignetlich das, was er soll.

    Lediglich kann ich keine Rückgabecodes des externen Programms auswerten. Das wäre aber wichtig für die Erfolgskontrolle.

    Gibt es da besseren Code ?

    Zu Erläuterung:

    Das externe Programm trägt Termine in einen öffentlichen Ordner des Exchange ein und benutzt dazu die EWS API.

    Leider ist es mir beisher nicht gelungen die Kernfunktionen meiner eigenen DLL aus VBA heruas zu benutzen. Daher der Workaround über ein vollständiges Programm.

    Donnerstag, 5. März 2015 20:13

Alle Antworten