Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- Option Explicit
- Private Declare Function GetExitCodeProcess Lib "kernel32" (ByVal hProcess As Long, lpExitCode As Long) As Long
- Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
- Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
- Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
- Private 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
- Public Const INFINITE = &HFFFF
- Public Const PROCESS_ALL_ACCESS = &H1F0FFF
- Sub RunApplication(ByVal Cmd As String)
- Dim lTaskID As Double
- Dim lPID As Long
- Dim lExitCode As Long
- lTaskID = Shell(Cmd, vbNormalFocus)
- 'Get process handle
- lPID = OpenProcess(PROCESS_ALL_ACCESS, True, lTaskID)
- If lPID Then
- 'Wait for process to finish
- Call WaitForSingleObject(lPID, INFINITE)
- 'Get Exit Process
- If GetExitCodeProcess(lPID, lExitCode) Then
- 'Received value
- MsgBox "Successfully returned " & lExitCode, vbInformation
- Else
- MsgBox "Failed: " & DLLErrorText(Err.LastDllError), vbCritical
- End If
- Else
- MsgBox "Failed: " & DLLErrorText(Err.LastDllError), vbCritical
- End If
- lTaskID = CloseHandle(lPID)
- End Sub
- Public Function DLLErrorText(ByVal lLastDLLError As Long) As String
- Dim sBuff As String * 256
- Dim lCount As Long
- Const FORMAT_MESSAGE_ALLOCATE_BUFFER = &H100, FORMAT_MESSAGE_ARGUMENT_ARRAY = &H2000
- Const FORMAT_MESSAGE_FROM_HMODULE = &H800, FORMAT_MESSAGE_FROM_STRING = &H400
- Const FORMAT_MESSAGE_FROM_SYSTEM = &H1000, FORMAT_MESSAGE_IGNORE_INSERTS = &H200
- Const FORMAT_MESSAGE_MAX_WIDTH_MASK = &HFF
- lCount = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM Or FORMAT_MESSAGE_IGNORE_INSERTS, 0, lLastDLLError, 0&, sBuff, Len(sBuff), ByVal 0)
- If lCount Then
- DLLErrorText = Left$(sBuff, lCount - 2) 'Remove line feeds
- End If
- End Function
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement