|
begin process at 2008 07 05 14:35:57
Derniers logiciels
|
Trouver une ressource (Nouvelle version du moteur, plus rapide & pertinent, essayez le !)
Vous ne trouvez pas de réponse à votre problème ? Alors posez la question dans le forum.
Souvenez-vous qu'il n'y a jamais de question bête, mais rester dans l'ignorance parce que l'on n'ose pas poser une question, ça c'est une erreur !
OUVERTURE D'UN FICHIER PAR UN LOGICIEL EXTERNE
Information sur la source
Description
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
- 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
-
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
Historique
- 27 septembre 2006 18:53:12 :
- Correction des fautes, Rajout des déclarations oubliées
- 09 octobre 2006 16:01:05 :
- Correction de l'association des flags d'option pour le MsgBox : vbCritical & vbOKOnly --> vbCritical Or vbOKOnly
Sources de la même categorie
Commentaires
Discussions en rapport avec ce code source
|
CalendriCode
| | | L | M | M | J | V | S | D |
| | 1 | 2 | 3 | 4 | 5 | 6 |
| 7 | 8 | 9 | 10 | 11 | 12 | 13 |
| 14 | 15 | 16 | 17 | 18 | 19 | 20 |
| 21 | 22 | 23 | 24 | 25 | 26 | 27 |
| 28 | 29 | 30 | 31 | | | |
|
Téléchargements
Logiciels à télécharger sur le même thème :
|
|