Excel下创建新进程且等待执行完成

Option Explicit

Private Const PROCESS_ALL_ACCESS = &H1F0FFF

Private Type TCell
  Col As Long
  Row As Long
End Type


Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function GetExitCodeProcess Lib "kernel32" (ByVal hProcess As Long, lpExitCode As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)


Private Sub CommandButton1_Click()
Dim PID As Long
Dim hProcess As Long
Dim exitCode As Long

    PID = Shell("c:\program files\winrar\winrar.exe", vbNormalFocus)  '"c:\windows\notepad.exe"
    hProcess = OpenProcess(PROCESS_ALL_ACCESS, False, PID)
    Do
        Call GetExitCodeProcess(hProcess, exitCode)
        Sheet1.Cells(2, 1) = Now
        Sleep 1000
        DoEvents
    Loop While exitCode <> 0
    Call CloseHandle(hProcess)
    
    MsgBox "You have closed the notepad!", vbOKOnly, "Hello, Buddy!"
End Sub

Private Sub CommandButton2_Click()
Dim vCell(20) As TCell
Dim i As Integer
Dim n As Integer

For i = 0 To 9
  vCell(i).Col = i + 1
  vCell(i).Row = 20
Next i

For i = 10 To 19
  vCell(i).Col = 20 - i
  vCell(i).Row = 21
Next i

While 1 > 0
    n = 19
    For i = 0 To 19
      Sheet1.Range(Sheet1.Cells(vCell(i).Row, vCell(i).Col), Sheet1.Cells(vCell(i).Row, vCell(i).Col)).Interior.Color = 400
      Sheet1.Range(Sheet1.Cells(vCell(n).Row, vCell(n).Col), Sheet1.Cells(vCell(n).Row, vCell(n).Col)).Interior.Color = 16777215
      'Sheet1.Cells(vCell(i).Row, vCell(i).Col) = i + 1
      n = i
      
      If Sheet1.Cells(1, 1) <> "" Then Exit Sub
      
      Sleep 350
      DoEvents
    Next i
    Sheet1.Range(Sheet1.Cells(vCell(19).Row, vCell(19).Col), Sheet1.Cells(vCell(19).Row, vCell(19).Col)).Interior.Color = 16777215
Wend

End Sub