Quantcast
Channel: Microsoft Access Forum
Viewing all articles
Browse latest Browse all 880

RÜckgabecodes von Kommandozeilenprogrammen auswerten ...

$
0
0

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.


Viewing all articles
Browse latest Browse all 880


<script src="https://jsc.adskeeper.com/r/s/rssing.com.1596347.js" async> </script>