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
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
| Option Explicit
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
Private Declare Function ShellExecuteForExplore Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As String, lpParameters As Any, lpDirectory As Any, ByVal nShowCmd As Long) As Long
Public Enum EShellShowConstants
zouSW_HIDE = 0
zouSW_MAXIMIZE = 3
zouSW_MINIMIZE = 6
zouSW_SHOWMAXIMIZED = 3
zouSW_SHOWMINIMIZED = 2
zouSW_SHOWNORMAL = 1
zouSW_SHOWNOACTIVATE = 4
zouSW_SHOWNA = 8
zouSW_SHOWMINNOACTIVE = 7
zouSW_SHOWDEFAULT = 10
zouSW_RESTORE = 9
zouSW_SHOW = 5
End Enum
Private Const ERROR_FILE_NOT_FOUND = 2&
Private Const ERROR_PATH_NOT_FOUND = 3&
Private Const ERROR_BAD_FORMAT = 11&
Private Const SE_ERR_ACCESSDENIED = 5 ' accès interdit
Private Const SE_ERR_ASSOCINCOMPLETE = 27
Private Const SE_ERR_DDEBUSY = 30
Private Const SE_ERR_DDEFAIL = 29
Private Const SE_ERR_DDETIMEOUT = 28
Private Const SE_ERR_DLLNOTFOUND = 32
Private Const SE_ERR_FNF = 2 ' Fichier non trouvé
Private Const SE_ERR_NOASSOC = 31
Private Const SE_ERR_PNF = 3 ' chemin inconnu
Private Const SE_ERR_OOM = 8 ' dépassement de mémoire
Private Const SE_ERR_SHARE = 26
Public Function ShellEx(ByVal sFile As String, _
Optional ByVal eShowCmd As EShellShowConstants = zouSW_SHOWDEFAULT, _
Optional ByVal sParameters As String = "", _
Optional ByVal sDefaultDir As String = "", _
Optional sOperation As String = "open", _
Optional Owner As Long = 0 _
) As Boolean
Dim lR As Long
Dim lErr As Long, sErr As String
If (InStr(UCase$(sFile), ".EXE") <> 0) Then
eShowCmd = 0
End If
On Error Resume Next
If (sParameters = "") And (sDefaultDir = "") Then
lR = ShellExecuteForExplore(Owner, sOperation, sFile, 0, 0, zouSW_SHOWNORMAL)
Else
lR = ShellExecute(Owner, sOperation, sFile, sParameters, sDefaultDir, eShowCmd)
End If
'MsgBox lR
If (lR < 0) Or (lR > 32) Then
ShellEx = True
Else
lErr = vbObjectError + 1048 + lR
Select Case lR
Case 0
lErr = 7: sErr = "Dépassement de mémoire"
Case ERROR_FILE_NOT_FOUND
lErr = 53: sErr = "Fichier non trouvé"
Case ERROR_PATH_NOT_FOUND
lErr = 76: sErr = "Chemin inconnu"
Case ERROR_BAD_FORMAT
sErr = "L'exécutable n'est pas valide ou est corrompu"
Case SE_ERR_ACCESSDENIED
lErr = 75: sErr = "Erreur/ accès au répertoire ou au fichier"
Case SE_ERR_ASSOCINCOMPLETE
sErr = "Ce type de fichier est sans association valable"
Case SE_ERR_DDEBUSY
lErr = 285: sErr = "Le fichier n'a pu être ouvert car en cours d'utilisation. Recommencez plus tard SVP."
Case SE_ERR_DDEFAIL
lErr = 285: sErr = "Le fichier n'a pu être ouvert car la transaction DDE a failli. Recommencez plus tard SVP."
Case SE_ERR_DDETIMEOUT
lErr = 286: sErr = "Le fichier n'a pu être ouvert (délai max dépassé). Recommencez plus tard SVP."
Case SE_ERR_DLLNOTFOUND
lErr = 48: sErr = "Impossible de trouver la DLL spécifiée."
Case SE_ERR_FNF
lErr = 53: sErr = "Fichier non trouvé"
Case SE_ERR_NOASSOC
sErr = "Aucune association définie pour ce type de fichier"
Case SE_ERR_OOM
lErr = 7: sErr = "Mémoire épuisée"
Case SE_ERR_PNF
lErr = 76: sErr = "Chemin inconnu"
Case SE_ERR_SHARE
lErr = 75: sErr = "Violation de partage !."
Case Else
sErr = "Une erreur a surgi au moment d'essayer d'ouvrir ou d'éditer le fichier choisi."
End Select
MsgBox "Error n°" & CStr(lErr) & Chr(13) & sErr & " sur ouverture : " & Chr(13) & sFile, vbCritical
ShellEx = False
End If
End Function |
[VBA-Excel] Liste fichier de repertoire selon critere
Répondre avec citation
et 
si la réponse vous a été utile !
Partager