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.