Ce code permet d'ouvrir un fichier quelconque dans le logiciel associé à ce type de fichier.
Il suffit de passer en argument le nom du fichier (avec chemin complet).
La fonction vérifie l'existence du fichier, recherche le logiciel associé au type de fichier et ouvre le fichier dans ce logiciel.
Un argument optionnel permet de suspendre le process tant que le logiciel externe n'a pas été fermé.
CADEAU : Code librement réutilisable :)
PS : Ce code a été développé au départ pour ouvrir des pdf (suivant les versions d'acrobat reader, il n'était pas installé au même endroit). Finalement, il s'est révélé générique.
Source / Exemple :
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 Or vbOKOnly, "ERREUR - OuvrirFichier"
'------------------------------------------------------------------------------------------
End Function
Conclusion :
Copier ce code dans un module
L'utilisation se fait ainsi :
retour = OuvrirFichier("Nom&CheminFichier") ' Pour une exécution asynchrone
retour = OuvrirFichier("Nom&CheminFichier", False) ' Idem
retour = OuvrirFichier("Nom&CheminFichier", True) ' Pour une exécution synchrone (suspension du process et attente de fermeture)
Problème connu et géré (voir partie "Code à personnaliser"): La fonction Shell génère une erreur si l'applicatif associé n'est pas un exécutable. Dans ce cas l'ouverture du fichier ne marche pas (ex: Fichier image, lorsque c'est l'"Aperçu des images et Télécopie Windows" qui est associé aux fichiers images
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.