Código [Seleccionar]
Option Explicit
Private Const STILL_ACTIVE As Long = &H103
Private Const PROCESS_QUERY_INFORMATION As Long = &H400
Private Declare Function EnumProcesses Lib "PSAPI.DLL" (lpidProcess As Long, ByVal cb As Long, cbNeeded As Long) As Long
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare Function GetExitCodeProcess Lib "kernel32" (ByVal hProcess As Long, lpExitCode 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
Public Function ShellWait( _
ByVal sShell As String, _
Optional ByVal eFocus As VbAppWinStyle = vbNormalFocus) As Boolean
Dim lhProcess As Long
Dim lRet As Long
Dim lProc As Long
Dim cProcs As Collection
On Local Error GoTo ShellWait_Error
If ShellExecute(0, vbNullString, _
sShell, vbNullString, vbNullString, eFocus) > 32 Then
Set cProcs = EnumProcs
lProc = cProcs.Item(cProcs.Count)
End If
lhProcess = OpenProcess( _
PROCESS_QUERY_INFORMATION, _
False, _
lProc)
If (lhProcess = 0) Then
Exit Function
End If
Do
Call GetExitCodeProcess(lhProcess, lRet)
DoEvents: Call Sleep(100)
Loop While lRet = STILL_ACTIVE
CloseHandle lhProcess
ShellWait = True
On Error GoTo 0
Exit Function
ShellWait_Error:
End Function
Private Function EnumProcs() As Collection
Dim lvProcesses() As Long
Dim lNedded As Long
Dim i As Long
Dim cTemp As New Collection
ReDim lvProcesses(0 To 1023) As Long
If (EnumProcesses(lvProcesses(0), 4096, lNedded) <> 0) Then
For i = 0 To (lNedded / 4) - 1
cTemp.Add lvProcesses(i)
Next i
End If
Set EnumProcs = cTemp
End Function
Edit: Modifique esta linea sShell, vbNullString, vbNullString, eFocus) >= 32 Then
