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 32 33 34 35 36 37 38 39 40 41 42 43
| Private Declare Function FindExecutable Lib "shell32.dll" _
Alias "FindExecutableA" (ByVal lpFile As String, _
ByVal lpDirectory As String, ByVal lpResult As String) As Long
Private Const MAX_FILENAME_LEN = 260
Private Sub TEST()
Dim strApplicationFilename As String
Dim strMyFile As String
Dim strFullExecutionPath As String
Dim lngShell As Double
strMyFile = "C:\MyPDFDocument.pdf"
strApplicationFilename = GetApplicationFilename(strMyFile)
If Len(strApplicationFilename) Then
If MsgBox("L'application associé a été trouvée, il s'agit de :" & _
vbCrLf & strApplicationFilename & vbCrLf & vbCrLf & "Voulez-vous ouvrir '" & _
strMyFile & "' ?", 36) = 6 Then
strFullExecutionPath = strApplicationFilename & " " & strMyFile
lngShell = Shell(strFullExecutionPath, 3)
End If
Else
MsgBox "Aucune application n'est installée sur le poste pour les _
des fichiers du type '" & strMyFile & " !", 48
End If
End Sub
Private Function GetApplicationFilename(ByVal ApplicationFilename As String) _
As String
Dim lngSuccess As Integer, strBuffer As String
Dim strExecutablePath As String
strExecutablePath = vbNullString
If Dir(ApplicationFilename) = vbNullString Or Len(ApplicationFilename) = 0 Then
Else
strBuffer = String(MAX_FILENAME_LEN, 32)
lngSuccess = FindExecutable(ApplicationFilename, vbNullString, strBuffer)
If lngSuccess > 32 Then
strExecutablePath = Left$(strBuffer, InStr(strBuffer, Chr$(0)) - 1)
End If
End If
GetApplicationFilename = strExecutablePath
End Function |
Partager