Public Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long Public Declare Function FindExecutable Lib "shell32.dll" Alias "FindExecutableA" ( _ ByVal lpFile As String, _ ByVal lpDirectory As String, _ ByVal lpResult As String) As Long Public Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, _ ByVal bInheritHandle As Long, _ ByVal dwProcessId As Long) As Long Public Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, _ ByVal dwMilliseconds As Long) As Long Public Const INFINITE = &HFFFFFFFF ' Infinite timeout Public Const SYNCHRONIZE = &H100000 '--------------------------------------------------------------------------------------- ' Procedure : OuvrirFichier ' DateTime : 27/09/2006 18:20 ' Author : Casy ' Purpose : Permet d'ouvrir un document avec l'applicatif (.exe) par défaut. ' Vérifie d'abord si le fichier existe, si un applicatif est installé ' Possibilité de bloquer le process tant que l'applicatif n'est pas fermé ' Retourne TRUE si l'ouverture s'est bien passée, FALSE sinon. '--------------------------------------------------------------------------------------- Public Function OuvrirFichier(fichier As String, Optional attenteFermeture As Boolean = False) As Boolean Dim fileappli As String * 250 Dim result As Integer Dim temp As String Dim fichAOuvrir As String Dim i As Integer Dim pid As Double Dim phnd As Long On Error GoTo OuvrirFichier_Error temp = Dir$(fichier) 'recherche si le fichier existe If temp <> "" Then ' Le fichier existe ' Recherche l'exécutable associé result = FindExecutable(fichier, vbNullString, fileappli) If result > 32 Then ' Association trouvée i = InStr(1, fileappli, Chr(0), vbBinaryCompare) - 1 fichAOuvrir = """" & Left$(fileappli, i) & """ " & fichier Else ' Aucune association de trouvée OuvrirFichier = False Exit Function End If Else ' Le fichier n'existe pas OuvrirFichier = False Exit Function End If ' Ouverture du fichier pid = Shell(fichAOuvrir, vbMaximizedFocus) If pid <> 0 Then ' Si attente fermeture demandé, on suspend le process jusqu'à que le logiciel soit fermé. If attenteFermeture = True Then phnd = OpenProcess(SYNCHRONIZE, 0, pid) If phnd <> 0 Then Call WaitForSingleObject(phnd, INFINITE) Call CloseHandle(phnd) End If End If OuvrirFichier = True Else OuvrirFichier = False End If On Error GoTo 0 Exit Function OuvrirFichier_Error: OuvrirFichier = False '---- Code à personaliser en cas d'erreur ------------------------------------------------- Dim message As String message = "Erreur " & Err.Number & " (" & Err.Description & ") dans la procedure OuvrirFichier" & vbCrLf & vbCrLf message = message & "Vérifier que le fichier est accessible !" & vbCrLf message = message & "Vérifier que le logiciel associé est un exécutable !" MsgBox message, vbCritical & vbOKOnly, "ERREUR - OuvrirFichier" '------------------------------------------------------------------------------------------ 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.