Lu76Fer
XLDnaute Occasionnel
Il existe une solution simple qui doit pouvoir fonctionner sur un fichier mais aussi sur des liens externes mais qui demande d'avoir des droits d'accès bien configurés en utilisant ThisWorkbook.FollowHyperlink {lien}. N'ayant moi-même pas configuré les droits correctement, je ne vais donc pas vous donnez plus de détails et vous renvoie plutôt sur un autre article : Ouvrir-tout-fichier-à-partir-de-listbox
Ici une autre solution plus directe qui permet d'ouvrir un lien fichier uniquement, un fichier ou d'ouvrir l'explorateur sur un fichier ou dossier. En utilisant la fonction système ShellExecute, on peut réaliser cela ainsi que d'autres opérations (voir l'aide en haut).
Ci-dessous, une proposition de fonction simplifiant l'utilisation de cette fonction système ainsi que les déclarations préalables :
VB:
#If VBA7 Then
Private Declare PtrSafe Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" ( _
ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, _
ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
#Else
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" ( _
ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, _
ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
#End If
'Message utilisateur
Const MSG_FILEERR = "ERREUR D'OPERATION FICHIER"
Const MSG_FILEOPEN = "Impossible d'ouvrir ce fichier !"
'Lance une opération windows
' sOperation : "OPEN" par défaut. Autres : "NEW", ....
' isShow : Si vrai, demande un affichage par défaut(ignoré si non pertinant)
' sFullFileName : nom complet du fichier sur lequel l'opération est faite
' sParameters : paramètres, sDirectory : répertoire
2'Retour : un numéro d'erreur
Function RunWinAction(Optional sOperation As String = "", Optional isShow As Boolean = True, _
Optional sFullFileName As String = "", Optional sParameters As String = "", Optional sDirectory As String = "") As Long
Const SW_SHOW = 5, SW_HIDE = 0
Dim lngErr&
lngErr = ShellExecute(Application.hwnd, sOperation, sFullFileName, sParameters, sDirectory, IIf(isShow, SW_SHOW, SW_HIDE))
If lngErr <> 42 Then RunWinAction = lngErr 'Si erreur, renvoyer son numéro
End Function
Tout d'abord, il est important d'observer que le premier paramètre hWnd est initialisé avec Application.hwnd et non à 0 comme j'ai pu le voir sur les FORUMS ... Ce paramètre à son importance même si dans la plupart des cas cela n'aura aucune incidence. Si vous utilisez la fonction système pour ouvrir un fichier Excel; avec hWnd=0, cela bloquera l'exécution et vous serez sans doute obligé de relancer votre session !
Il est a noter que le paramètre nShowCmd est égale à SW_SHOW par défaut (isShow=True) car cela permet de soliciter l'affichage mais sans provoquer d'erreur si le paramètre n'est pas pris en compte.
Ouverture d'un fichier, remplacez les valeurs path et fileName si vous souhaitez tester :
Ouverture de l'explorateur avec la sélection sur un dossier ou fichier :
Remarque : il n'y a pas de retour d'erreur pour savoir si l'explorateur s'est ouvert en respectant les doléances.
Il est a noter que le paramètre nShowCmd est égale à SW_SHOW par défaut (isShow=True) car cela permet de soliciter l'affichage mais sans provoquer d'erreur si le paramètre n'est pas pris en compte.
Ouverture d'un fichier, remplacez les valeurs path et fileName si vous souhaitez tester :
VB:
Sub OpenFile()
Dim iTmp%, path$, fileName$
'Chemin
path = "D:\Temp"
'Nom du Fichier
fileName = "image.jpg"
path = path & IIf(Right(path, 1) = "\", "", "\")
If RunWinAction("OPEN", , """" & path & fileName & """") Then _
MsgBox MSG_FILEOPEN, vbOKOnly Or vbApplicationModal Or vbExclamation, MSG_FILEERR
End Sub
Ouverture de l'explorateur avec la sélection sur un dossier ou fichier :
VB:
Sub OpenExplorerOnFileOrFolder()
Dim iTmp%, path$, fileName$
'Chemin
path = "D:\_Temp"
'Nom du Fichier ou Dossier
fileName = "Ordonnance.jpg" ' fileName = "TMP"
path = path & IIf(Right(path, 1) = "\", "", "\")
RunWinAction "OPEN", , "EXPLORER", "/select, """ & path & fileName & """" 'Explore le répertoire
End Sub