1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51
| Option Explicit
Public Const SEE_MASK_DOENVSUBST As Long = &H200
Public Const SEE_MASK_IDLIST As Long = &H4
Public Const SEE_MASK_NOCLOSEPROCESS As Long = &H40
Public Const SW_HIDE As Long = 0
Public Const SW_SHOW As Long = 5
Public Const WAIT_TIMEOUT As Long = 258&
Public Type SHELLEXECUTEINFOA
cbSize As Long
fMask As Long
hwnd As Long
lpVerb As String
lpFile As String
lpParameters As String
lpDirectory As String
nShow As Long
hInstApp As Long
lpIDList As Long
lpClass As String
hkeyClass As Long
dwHotKey As Long
hIcon As Long
hProcess As Long
End Type
Public Declare Function CloseHandle Lib "kernel32.dll" (ByVal hObject As Long) As Long
Public Declare Function GetExitCodeProcess Lib "kernel32.dll" (ByVal hProcess As Long, ByRef lpExitCode As Long) As Long
Public Declare Function ShellExecuteEx Lib "shell32.dll" (ByRef lpExecInfo As SHELLEXECUTEINFOA) As Long
Public Declare Function WaitForSingleObject Lib "kernel32.dll" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Public Function ShellWait(ByRef vsCmdLine As String, Optional ByRef vsParameters As String, Optional ByRef vsCurrentDirectory As String = vbNullString, Optional ByVal vnShowCmd As Long = SW_SHOW, Optional ByVal vnTimeOut As Long = 200) As Long
Dim lpShellExInfo As SHELLEXECUTEINFOA
With lpShellExInfo
.cbSize = Len(lpShellExInfo)
.lpDirectory = vsCurrentDirectory
.lpVerb = "open"
.lpFile = vsCmdLine
.lpParameters = vsParameters
.nShow = vnShowCmd
.fMask = SEE_MASK_DOENVSUBST Or SEE_MASK_NOCLOSEPROCESS Or SEE_MASK_IDLIST
End With
If ShellExecuteEx(lpShellExInfo) Then
Do While WaitForSingleObject(lpShellExInfo.hProcess, vnTimeOut) = WAIT_TIMEOUT
DoEvents
Loop
GetExitCodeProcess lpShellExInfo.hProcess, ShellWait
CloseHandle lpShellExInfo.hProcess
Else
ShellWait = vbError
End If
End Function |
Partager