Tuer Process ADOBE lancé par Excel (VBA)
Bonjour,
rencontrant des problèmes pour tuer des process Adobe lancé par VBA en utilisant le Hwnd de la fenêtre,
je me suis inspiré de ce post pour réaliser un code qui doit pouvoir tuer un processus Adobe lancé par Excel. (Excel affiche un PDF généré).
Mon problème, de taille, est que le processus tué est Excel Lui-même et que Adobe reste bien actif.
Voici mon code :
1) Lancement de Adobe
Dans userform
Code:
1
2
| Show_PhWnd = OpenProgram(Work_folder & "Last_Fiche.PDF", 0)
Show_Pid = Ret_Pid |
Dans Module
Code:
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
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
| Option Explicit
'Flags ShellExecuteEx
Private Const SEE_MASK_NOCLOSEPROCESS = &H40
Private Const SEE_MASK_FLAG_NO_UI = &H400
'Constantes ERREUR ShellExecuteEx
Private Const SE_ERR_FNF As Byte = 2
Private Const SE_ERR_PNF As Byte = 3
Private Const SE_ERR_ACCESSDENIED As Byte = 5
Private Const SE_ERR_OOM As Byte = 8
Private Const SE_ERR_SHARE As Byte = 26
Private Const SE_ERR_ASSOCINCOMPLETE As Byte = 27
Private Const SE_ERR_DDETIMEOUT As Byte = 28
Private Const SE_ERR_DDEFAIL As Byte = 29
Private Const SE_ERR_DDEBUSY As Byte = 30
Private Const SE_ERR_NOASSOC As Byte = 31
Private Const SE_ERR_DLLNOTFOUND As Byte = 32
'Constantes AFFICHAGE ShellExecuteEx
Private Const SW_SHOWNORMAL = 1
Private Const SW_SHOW = 5
Private Const SW_SHOWNA = 8
Private Const SW_SHOWNOACTIVE = 4
Private Const SW_SHOWDEFAULT = 10
Private Const SW_SHOWMINIMIZED = 2
Private Type SHELLEXECUTEINFO
cbSize As Long
fMask As Long
hWnd As Long
lpVerb As String
lpFile As String
lpParameters As String
lpDirectory As String
nShow As Long
hInstApp As Long
lpIDList As Long
lpClass As String
hkeyClass As Long
dwHotKey As Long
hIcon As Long
hProcess As Long
End Type
'OpenProgram
Private Declare Function ShellExecuteEx Lib "shell32.dll" _
(SEI As SHELLEXECUTEINFO) As Long
Private Declare Function ShellExecute Lib "shell32.dll" _
(SEI As SHELLEXECUTEINFO) As Long
'CloseProgram
Private Declare Function CloseHandle Lib "kernel32" _
(ByVal hObject As Long) As Long
Private Declare Function TerminateProcess Lib "kernel32" _
(ByVal hProcess As Long, ByVal uExitCode As Long) As Long
'>>>V7.13
Private Declare Function GetWindowThreadProcessId Lib "user32" _
(ByVal hWnd As Long, lpdwProcessId As Long) As Long
Private Declare Function OpenProcess Lib "Kernel32.dll" _
(ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessID As Long) As Long
'<<<V7.13
Private Declare Sub Sleep Lib "kernel32" _
(ByVal dwMilliseconds As Long)
Public Const WM_CLOSE = &H10
Const GW_HWNDNEXT = 2
Const PROCESS_TERMINATE As Long = &H1
'...
Public Ret_Pid As Long
Dim PhWnd As Long
'...[
' ***********************************************************
' *
' * Lance le programme par défaut associé à un fichier (en fonction de son
' * extension ) et retourne le hWnd de la fênetre du programme lançé.
' *
' ***********************************************************
Public Function OpenProgram(ByRef Filename As String, ByRef OwnerhWnd As Long) As Long
Dim SEI As SHELLEXECUTEINFO
'On Error GoTo ErrorHandler
'Vérifie si le fichier à lancer est un exécutable (.exe)
If GetExtension(Filename) = "exe" Then
If vbNo = MsgBox("ATTENTION, êtes-vous sûr de vouloir lancer ce programme exécutable ?", vbExclamation + vbYesNo) _
Then
OpenProgram = 0
Ret_Pid = 0
Exit Function
End If
End If
With SEI
.cbSize = Len(SEI)
.fMask = SEE_MASK_NOCLOSEPROCESS Or SEE_MASK_FLAG_NO_UI
.hWnd = OwnerhWnd
.lpVerb = "open"
.lpFile = Filename
.lpParameters = vbNullChar
.lpDirectory = vbNullChar
.nShow = SW_SHOW
.hInstApp = OwnerhWnd
End With
OpenProgram = ShellExecuteEx(SEI)
If SEI.hInstApp <= 32 Then
'Erreurs
OpenProgram = 0
Ret_Pid = 0
Select Case SEI.hInstApp
Case SE_ERR_FNF
OpenProgram = SEI.hProcess
Case SE_ERR_PNF
MsgBox "Le chemin du fichier à ouvrir est incorrect.", vbExclamation
Case SE_ERR_ACCESSDENIED
MsgBox "Accès au fichier refusé.", vbExclamation
Case SE_ERR_OOM
MsgBox "Mémoire insuffisante.", vbExclamation
Case SE_ERR_DLLNOTFOUND
MsgBox "Dynamic-link library non trouvé.", vbExclamation
Case SE_ERR_SHARE
MsgBox "Le fichier est déjà ouvert.", vbExclamation
Case SE_ERR_ASSOCINCOMPLETE
MsgBox "Information d'association du fichier incomplète.", vbExclamation
Case SE_ERR_DDETIMEOUT
MsgBox "Opération DDE dépassée.", vbExclamation
Case SE_ERR_DDEFAIL
MsgBox "Opération DDE echouée.", vbExclamation
Case SE_ERR_DDEBUSY
MsgBox "Opération DDE occupée.", vbExclamation
Case SE_ERR_NOASSOC
'Ouvrir avec...
Call Shell("rundll32.exe shell32.dll,OpenAs_RunDLL " + Filename, vbNormalFocus)
End Select
Else
'Retourne le hWnd du programme lançé par ShellExecuteEx
OpenProgram = SEI.hProcess
'V7.13
GetWindowThreadProcessId SEI.hProcess, Ret_Pid
End If
Exit Function
ErrorHandler:
OpenProgram = 0
End Function |
Tentative d'arret de ADOBE (plus tard dans le traitement).
Dans le Userform
Code:
1
2
3
4
| If Show_Pid <> 0 Then
KillProcess (Show_Pid)
DoEvents
End If |
Dans un module
Code:
1
2
3
4
5
6
7
8
9
10
11
12
13
| Public Sub KillProcess(pid As Long)
'V7.13
'Fermeture du processus
Dim hProc As Long
Dim Retval As Long
hProc = OpenProcess(PROCESS_TERMINATE, 0, pid)
If hProc <> 0 Then
Retval = TerminateProcess(hProc, 0)
' Si Retval = 0 échec de la fonction TerminateProcess(..)
CloseHandle hProc
End If
End Sub |
Pouvez-vous me dire où je me plante et comment ENFIN parvenir à tuer proprement ADOBE lancé par cette même instance d'Excel.
D'avance merci.
---------Edit-----12h35
petite précision qui peut s'avérer utile.
J'utilise l'excellent Outil gratuit ProcessExplorer (de Sysinternals) pour voir les PID des processus lancés.
Quand je reprend le PID de mon Adobe donné par Process Explorer, le KillProcess fonctionne parfaitement.
Le problème est que le PID retourné par mon code VBA est différent, mais ce n'est pas non plus celui de Excel. :aie:
