Ver Mensaje Individual
  #2 (permalink)  
Antiguo 17/08/2010, 06:42
Avatar de A.H.H
A.H.H
 
Fecha de Ingreso: mayo-2007
Ubicación: IRUN,(GUIPUZCOA) España
Mensajes: 178
Antigüedad: 17 años
Puntos: 4
Respuesta: Ejecutar lista de un Listbox

Hola yo tengo un ejemplo de lo que tu pides, tengo un listbox con estilo checkbox(style=1).
lo que hago es mediante un select case ver las opciones que estan clickcadas de la lista del listbox y luego ir llamando a cada programa mediante una api que existe shellandwait que lo que hace es llamar a un proceso y esperar a que termine este.

la api shellandwait la pones en un MODULO:

Cita:
Option Explicit
Private Declare Function OpenProcess Lib "kernel32" _
(ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, _
ByVal dwProcessId As Long) As Long
Private Declare Function GetExitCodeProcess Lib "kernel32" _
(ByVal hProcess As Long, lpExitCode As Long) As Long
Private Const STATUS_PENDING = &H103&
Private Const PROCESS_QUERY_INFORMATION = &H400

Public Function ShellandWait(ExeFullPath As String, _
Optional TimeOutValue As Long = 0) As Boolean
Dim lInst As Long
Dim lStart As Long
Dim lTimeToQuit As Long
Dim sExeName As String
Dim lProcessId As Long
Dim lExitCode As Long
Dim bPastMidnight As Boolean
On Error GoTo ErrorHandler
lStart = CLng(Timer)
sExeName = ExeFullPath
'Deal with timeout being reset at Midnight
If TimeOutValue > 0 Then
If lStart + TimeOutValue < 86400 Then
lTimeToQuit = lStart + TimeOutValue
Else
lTimeToQuit = (lStart - 86400) + TimeOutValue
bPastMidnight = True
End If
End If
lInst = Shell(sExeName, vbNormalFocus)
lProcessId = OpenProcess(PROCESS_QUERY_INFORMATION, False, lInst) 'Optenemos el ProcessID
Do 'Aqui se genera un ciclo hasta que el proceso sea distinto de pendiente, o sea, Alla terminado.
Call GetExitCodeProcess(lProcessId, lExitCode) ' Optenemos el si hay exits code o todavia esta en ejecucion (pending)
DoEvents
If TimeOutValue And Timer > lTimeToQuit Then
If bPastMidnight Then
If Timer < lStart Then Exit Do
Else
Exit Do ' Se sale del ciclo si se acavo el tiemo de espera
End If
End If
Loop While lExitCode = STATUS_PENDING
ShellandWait = True
ErrorHandler:
ShellandWait = False
Exit Function
End Function
EN EL FORMULARIO EL SELECT CASE depende de donde lo quieras en un boton o ......

Cita:
dim retval as variant
For i = 0 To List1.ListCount - 1
If List1.Selected(i) = True Then
Select Case List1.List(i)
Case "Instalar el uno"'LOS CASES TIENEN QUE IR ESCRITOS IGUAL QUE EN LA LISTA'
...........
..........
retval = ShellandWait(RUTA AL EXE)
case "Instalar el dos"
........
.......
retval = ShellandWait(RUTA AL EXE)

End Select
End If
Next
SALU2 ESPERO TE SIRVA