Gestion des errorlevel en vb

Soyez le premier à donner votre avis sur cette source.

Snippet vu 11 434 fois - Téléchargée 30 fois

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

Ajouter un commentaire

Commentaires

Messages postés
1
Date d'inscription
lundi 29 septembre 2003
Statut
Membre
Dernière intervention
5 juillet 2007

Juste une petite modif, je pense qu'il manquait le "NOT" dans le if ;) :
Public Sub ExitProcess(uExitCode As Long)
'If isDEV Then ExitProcessA uExitCode
If Not isDEV Then ExitProcessA uExitCode
Msgbox "ERRORLEVEL:" & uExitCode
End
End Sub
Messages postés
1222
Date d'inscription
jeudi 23 août 2001
Statut
Membre
Dernière intervention
9 septembre 2018

Autre solution pour IsDev :

Public Function bIDE() As Boolean

' Retourner True si on est en mode debug dans l'IDE, sinon False (mode compilé .exe)
' (bIDE IsIDE Not IsCompiled)
' www.vbarchiv.net/forum/id2_i68236t68232.html
On Error Resume Next
Debug.Print 1 / 0
bIDE = (Err <> 0)
On Error GoTo 0

End Function

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.