Translate

2013年6月9日 星期日

[VBA] Do Shell Command And Wait it finishs

Below code are modified from internet.

Call ShellAndWait(ShellCmd, vbHide)

' Start the indicated program and wait for it
' to finish, hiding while we wait.
Public Declare Function GetExitCodeProcess Lib "kernel32" (ByVal hProcess As Long, lpExitCode As Long) As Long
Public Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Public Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long

Public 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

Const INFINITE = &HFFFF

Const SYNCHRONIZE = &H100000

Public Function ShellAndWait(ByVal cmd As String, _
    ByVal window_style As VbAppWinStyle) As Boolean
    Dim process_id As Long
    Dim process_handle As Long

    ' Start the program.
    On Error GoTo ShellError
    
    ShellAndWait = False
        
    process_id = Shell(cmd, window_style)
    On Error GoTo 0

    ' Wait for the program to finish.
    ' Get the process handle.
    process_handle = OpenProcess(SYNCHRONIZE, 0, process_id)
    
    If process_handle <> 0 Then
        WaitForSingleObject process_handle, INFINITE
        CloseHandle process_handle
        
        ShellAndWait = True
    End If

    Exit Function

ShellError:
    'MsgBox "Error starting task " & _
    '    txtProgram.text & vbCrLf & _
    '    Err.Description, vbOKOnly Or vbExclamation, _
    '    "Error"
    ShellAndWait = False

End Function

沒有留言:

張貼留言