VBA shell和等待退出代码

Question

我正在封装一个办公应用程序（VBA），它可以调用C＃控制台应用程序来执行应用程序（大型模拟程序）的一些繁重工作。我希望能够让VBA应用程序等待控制台应用程序完成以及从控制台应用程序中检索退出代码。我已经能够做到前者，但仍然无法从应用程序中检索退出代码。有没有什么办法可以使用像

Diagnostics.Process.Start(filePath) 

我已经看到了这个在VB中，但不确定关于VBA。否则，还有其他建议吗？

Answer 1

看看WaitForSingleObject和GetExitCodeProcess的功能。

实例应用：

Private Declare Function GetExitCodeProcess Lib "kernel32" (ByVal hProcess As Long, lpExitCode As Long) As Long 
Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long 
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long 
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long 
Private Declare Function FormatMessage Lib "kernel32" Alias "FormatMessageA" (ByVal dwFlags As Long, lpSource As Any, ByVal dwMessageId As Long, ByVal dwLanguageId As Long, ByVal lpBuffer As String, ByVal nSize As Long, Arguments As Long) As Long 

Public Const INFINITE = &HFFFF 
Public Const PROCESS_ALL_ACCESS = &H1F0FFF 

Sub RunApplication(ByVal Cmd as String) 

    lTaskID = Shell(Cmd, vbNormalFocus) 
    //Get process handle 
    lPID = OpenProcess(PROCESS_ALL_ACCESS, True, lTaskID) 
    If lPID Then 
     //Wait for process to finish 
     Call WaitForSingleObject(lPID, INFINITE) 
     //Get Exit Process 
     If GetExitCodeProcess(lPID, lExitCode) Then 
      //Received value 
      MsgBox "Successfully returned " & lExitCode, vbInformation 
     Else 
      MsgBox "Failed: " & DLLErrorText(Err.LastDllError), vbCritical 
     End If 
    Else 
     MsgBox "Failed: " & DLLErrorText(Err.LastDllError), vbCritical 
    End If 
    lTaskID = CloseHandle(lPID) 
End Sub 

Public Function DLLErrorText(ByVal lLastDLLError As Long) As String 
    Dim sBuff As String * 256 
    Dim lCount As Long 
    Const FORMAT_MESSAGE_ALLOCATE_BUFFER = &H100, FORMAT_MESSAGE_ARGUMENT_ARRAY = &H2000 
    Const FORMAT_MESSAGE_FROM_HMODULE = &H800, FORMAT_MESSAGE_FROM_STRING = &H400 
    Const FORMAT_MESSAGE_FROM_SYSTEM = &H1000, FORMAT_MESSAGE_IGNORE_INSERTS = &H200 
    Const FORMAT_MESSAGE_MAX_WIDTH_MASK = &HFF 

    lCount = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM Or FORMAT_MESSAGE_IGNORE_INSERTS, 0, lLastDLLError, 0&, sBuff, Len(sBuff), ByVal 0) 
    If lCount Then 
     DLLErrorText = Left$(sBuff, lCount - 2) \\Remove line feeds 
    End If 

End Function 

Answer 2

此功能已在ShellAndWait功能包裹起来。

优秀写在它上面here。