Gestion des errorlevel en vb

Commenter

Contenu du snippet

Deux sources :

1. Quitter une application avec une ERRORLEVEL (sauf si on est dans l'IDE !)
2. Lancer une programme, attendre sa fin d'execution, puis recupéré son ERRORLEVEL !

A+ Patrick

Source / Exemple : 


'==========================================================
' (C) Patrick MOIRE
' http://jeux.cartes.free.fr
'
' BUT: Quitter avec une ERRORLEVEL, sauf si on est dans l'IDE !
'==========================================================

Option Explicit

Declare Sub ExitProcessA Lib "kernel32" Alias "ExitProcess" (ByVal uExitCode As Long)
Declare Function GetModuleFileName Lib "kernel32" Alias "GetModuleFileNameA" (ByVal hModule As Long, ByVal lpFileName As String, ByVal nSize As Long) As Long
Const MAX_PATH = 260

Public Function isDEV() As Boolean
  Dim strModuleName As String * MAX_PATH
  Dim lngReturn As Long
    lngReturn = GetModuleFileName(App.hInstance, strModuleName, MAX_PATH)
    isDEV = Not (UCase(App.Path & "\" & App.EXEName & ".EXE") = UCase(Left(strModuleName, lngReturn)))
End Function

Public Sub ExitProcess(uExitCode As Long)
  If isDEV Then ExitProcessA uExitCode
  Msgbox "ERRORLEVEL:" & uExitCode
  End
End Sub

'===============================================================
' (C) Patrick MOIRE
' http:\\jeux.cartes.free.fr
'
' Exemple : Xshell "notepad.exe", vbNormalFocus
'===============================================================

Option Explicit

 '- - - - - - - - Appel d'un process Windows avec Attente
  Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
  Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
  Declare Function GetExitCodeProcess Lib "kernel32" (ByVal hProcess As Long, lpExitCode As Long) As Long
  Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
  
  Const PROCESS_QUERY_INFORMATION = &H400
  Const STILL_ACTIVE = &H103

 '- - - - - - - - Appel d'un process Windows avec Attente
  
  Public Function Xshell(Nom As String, Mode As VbAppWinStyle) As Boolean
  
    Dim hProcess As Long
    Dim RetVal As Long
    
     On Error GoTo Errshell
       hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, False, Shell(Nom, Mode))
       If hProcess = 0 Then Err.Raise -1, , "Can Open Process !"
     On Error GoTo 0
     
     Do
       GetExitCodeProcess hProcess, RetVal
       If RetVal = STILL_ACTIVE Then
         Sleep 1000
         DoEvents
       End If
     Loop Until RetVal <> STILL_ACTIVE

    'PS: RetVal contient alors le "ERRORLEVEL" de l'application !
     Xshell = (RetVal = 0)
	
     CloseHandle hProcess
     Exit Function
      
Errshell:
  MsgBox Error(Err), 16, "Appel de  " + Nom
  Exit Function
End Function

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (cs_patrick)