Attribute VB_Name = "Module1"

'Private Const SW_HIDE = 0
'Private Const SW_SHOWNORMAL = 1
'Private Const SW_NORMAL = 1
'Private Const SW_SHOWMINIMIZED = 2
'Private Const SW_SHOWMAXIMIZED = 3
'Private Const SW_MAXIMIZE = 3
'Private Const SW_SHOWNOACTIVATE = 4
'Private Const SW_SHOW = 5
'Private Const SW_MINIMIZE = 6
'Private Const SW_SHOWMINNOACTIVE = 7
'Private Const SW_SHOWNA = 8
'Private Const SW_RESTORE = 9
'Private Const SW_SHOWDEFAULT = 10
'Private Const SW_MAX = 10
Private Const NORMAL_PRIORITY_CLASS = &H20&
Private Const INFINITE = -1&
 
Private Type STARTUPINFO   '啟動信息
   CB As Long
   lpReserved As String
   lpDesktop As String
   lpTitle As String
   dwX As Long
   dwY As Long
   dwXSize As Long
   dwYSize As Long
   dwXCountChars As Long
   dwYCountChars As Long
   dwFillAttribute As Long
   dwFlags As Long
   wShowWindow As Integer
   cbReserved2 As Integer
   lpReserved2 As Long
   hStdInput As Long
   hStdOutput As Long
   hStdError As Long
End Type
 
Private Type PROCESS_INFORMATION  '操作信息
   hProcess As Long
   hThread As Long
   dwProcessID As Long
   dwThreadID As Long
End Type
 
'等待目標
Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
'建立操作
Private Declare Function CreateProcessA Lib "kernel32" (ByVal lpApplicationName As Long, ByVal lpCommandLine As String, ByVal lpProcessAttributes As Long, ByVal lpThreadAttributes As Long, ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, ByVal lpEnvironment As Long, ByVal lpCurrentDirectory As String, lpStartupInfo As STARTUPINFO, lpProcessInformation As PROCESS_INFORMATION) As Long
'關閉句柄
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
'給出退出操作
Private Declare Function GetExitCodeProcess Lib "kernel32" (ByVal hProcess As Long, lpExitCode As Long) As Long

'外殼等待
Public Function ShellAndWait(ByVal strPath As String, ByVal iWindowStyle As Integer, ByRef lreturnCode As Long, Optional sWinTitle As String = "", Optional sDirectoryPath As String = "") As Boolean
 
  Dim proc As PROCESS_INFORMATION
  Dim start As STARTUPINFO
  Dim ret As Long
 
  On Error GoTo ShellAndWaiterr
 
 ' 初始化啟動結構
   start.CB = Len(start) '必須設置大小
   start.dwFlags = &H1& ' STARTF_USESHOWWINDOW 使用顯示窗口
   start.wShowWindow = iWindowStyle
  
   If Not IsMissing(sWinTitle) Then
    '窗口標題
    start.lpTitle = sWinTitle
   End If
 
 ' 運行外部程序
   ret = CreateProcessA(0&, strPath, 0&, 0&, 1&, NORMAL_PRIORITY_CLASS, 0&, sDirectoryPath, start, proc)
 
 ' 等待外殼程序完成
   ret = WaitForSingleObject(proc.hProcess, 100&)
   
   Do While ret <> 0
      If ret < 0 Then
        ShellAndWait = False
        Exit Function
      End If
 
      DoEvents
 
      ret = WaitForSingleObject(proc.hProcess, 100&)
   
   Loop
 
  '給出返回的代碼
   ret = GetExitCodeProcess(proc.hProcess, lreturnCode)
  '關閉操作
   ret = CloseHandle(proc.hProcess)
   ShellAndWait = True
   Exit Function
 
ShellAndWaiterr:
   ShellAndWait = False
   Exit Function
   Resume
End Function