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