fermeture d'un Processus excel sous VB6

Question

bonjour tt le monde,
voilà j'ai vraiement besoin de votre aide.

j'ai besoin d'effectuer un tri de mon fichier excel à partir de VB.
actuellement j'utilise le code ci-dessous. le problème c que le processus Excel ne se termine pas après  SET xlApp = Nothing. j'ai verfié mon programme et à chaque fois je fais référence à mon objet excel, mais le problème perciste. Merci d'avance.

Set xlApp = New Excel.Application
xlApp.Visible = True
xlApp.Workbooks.Open txtFichierSource.Text
xlApp.Worksheets(1).Select
NomClasseurSource = xlApp.ActiveWorkbook.Name
NomFeuilleSource = xlApp.ActiveSheet.Name

with xlApp.Workbooks(NomClasseurSource).Worksheets(NomFeuilleSource)
    Columns("A:AQ").Select  
    Selection.Sort _
    Key1:=Range("E2"), _
    Order1:=xlAscending, _
    Header:=1, OrderCustom:=1, _
    MatchCase:=False, Orientation:=xlTopToBottom
End With
         
xlApp.Workbooks(NomClasseurSource).Close
xlApp.Quit
Set xlApp = Nothing

carnez · Answer

bonjour,

ah aie aie !!!!

combien de messages pour tuer un processus qui continue à tourner, bien que l'application soit fermée !!!

j'ai trouvé ça sur le forum; tu peux essayer, ça fonctionne bien que je n'y comprenne pas grand chose ...Il suffit de tester si le processus tourne encore alors que l'application est fermée et si oui, de lancer la routine "killprocessus"

Option Compare Database
Option Explicit

Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
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
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
Private Declare Function AdjustTokenPrivileges Lib "advapi32.dll" (ByVal TokenHandle As Long, ByVal DisableAllPrivileges As Long, NewState As TOKEN_PRIVILEGES, ByVal BufferLength As Long, PreviousState As TOKEN_PRIVILEGES, ReturnLength As Long) As Long
Private Declare Function OpenProcessToken Lib "advapi32.dll" (ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, TokenHandle As Long) As Long
Private Declare Function LookupPrivilegeValue Lib "advapi32.dll" Alias "LookupPrivilegeValueA" (ByVal lpSystemName As String, ByVal lpName As String, lpLuid As LUID) As Long
Private Declare Function GetCurrentProcess Lib "kernel32" () As Long
Declare Function ProcessFirst Lib "kernel32" Alias "Process32First" (ByVal hSnapshot As Long, uProcess As PROCESSENTRY32) As Long
Declare Function ProcessNext Lib "kernel32" Alias "Process32Next" (ByVal hSnapshot As Long, uProcess As PROCESSENTRY32) As Long
Declare Function CreateToolhelpSnapshot Lib "kernel32" Alias "CreateToolhelp32Snapshot" (ByVal lFlags As Long, lProcessID As Long) As Long

Private Type LUID
LowPart As Long
HighPart As Long
End Type

Private Type LUID_AND_ATTRIBUTES
pLuid As LUID
Attributes As Long
End Type

Private Type TOKEN_PRIVILEGES
PrivilegeCount As Long
TheLuid As LUID
Attributes As Long
End Type

Public Const MAX_PATH As Integer = 260
Public Const TH32CS_SNAPPROCESS As Long = 2&

Type PROCESSENTRY32
    dwSize As Long
    cntUsage As Long
    th32ProcessID As Long
    th32DefaultHeapID As Long
    th32ModuleID As Long
    cntThreads As Long
    th32ParentProcessID As Long
    pcPriClassBase As Long
    dwFlags As Long
    szexeFile As String * MAX_PATH
    End Type

Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Function ProcessTerminate(Optional lProcessID As Long, Optional lHwndWindow As Long) As Boolean
Dim lhwndProcess As Long
Dim lExitCode As Long
Dim lRetVal As Long
Dim lhThisProc As Long
Dim lhTokenHandle As Long
Dim tLuid As LUID
Dim tTokenPriv As TOKEN_PRIVILEGES, tTokenPrivNew As TOKEN_PRIVILEGES
Dim lBufferNeeded As Long
Const PROCESS_ALL_ACCESS &H1F0FFF, PROCESS_TERMINAT &H1Const ANYSIZE_ARRAY 1, TOKEN_ADJUST_PRIVILEGES &H20Const TOKEN_QUERY &H8, SE_DEBUG_NAME As String "SeDebugPrivilege"
Const SE_PRIVILEGE_ENABLED = &H2

On Error Resume Next
If lHwndWindow Then
'Get the process ID from the window handle
lRetVal = GetWindowThreadProcessId(lHwndWindow, lProcessID)
End If

If lProcessID Then
'Give Kill permissions to this process
lhThisProc = GetCurrentProcess

OpenProcessToken lhThisProc, TOKEN_ADJUST_PRIVILEGES Or TOKEN_QUERY, lhTokenHandle
LookupPrivilegeValue "", SE_DEBUG_NAME, tLuid
'Set the number of privileges to be change
tTokenPriv.PrivilegeCount = 1
tTokenPriv.TheLuid = tLuid
tTokenPriv.Attributes = SE_PRIVILEGE_ENABLED
'Enable the kill privilege in the access token of this process
AdjustTokenPrivileges lhTokenHandle, False, tTokenPriv, Len(tTokenPrivNew), tTokenPrivNew, lBufferNeeded

'Open the process to kill
lhwndProcess = OpenProcess(PROCESS_TERMINAT, 0, lProcessID)

If lhwndProcess Then
'Obtained process handle, kill the process
ProcessTerminate = CBool(TerminateProcess(lhwndProcess, lExitCode))
Call CloseHandle(lhwndProcess)
End If
End If
On Error GoTo 0
End Function

Public Function KillProcessus(nom_process) As String
Dim i As Integer
Dim hSnapshot As Long
Dim uProcess As PROCESSENTRY32
Dim r As Long
Dim nom(1 To 100)
Dim num(1 To 100)
Dim nr As Integer
nr = 0
hSnapshot = CreateToolhelpSnapshot(TH32CS_SNAPPROCESS, 0&)
If hSnapshot = 0 Then Exit Function
uProcess.dwSize = Len(uProcess)
r = ProcessFirst(hSnapshot, uProcess)
Do While r
nr = nr + 1
nom(nr) = uProcess.szexeFile
num(nr) = uProcess.th32ProcessID
r = ProcessNext(hSnapshot, uProcess)
Loop
For i = 1 To nr
If InStr(UCase(nom(i)), UCase(nom_process)) <> 0 Then
ProcessTerminate (num(i))
Exit For
End If
Next i
End Function

Colibri

wanirb · Answer

un tout petit peu compliquer, mais si ca resoude mon problème, je serai content.

merci bcp Colibri

arsenik20 · Answer

ben pkoi se compliquer la tache quand c si simple

Sub SuppProcXls()
' Permet d'effacer tout les processus actif Excel
Dim RetVal As Variant
' -------------------------------- Début du SUB ----------------------------------
RetVal = Shell("Taskkill /IM Excel.exe /F", 0)
End Sub

voila ma petite sub que j'appelle a chaque fois qu'il faut que je supprime des processus excell

seulement il supprime tout les proc actif ...

Webmaster http://www.federun.be

arsenik20 · Answer

ben pkoi se compliquer la tache quand c si simple

Sub SuppProcXls()
' Permet d'effacer tout les processus actif Excel
Dim RetVal As Variant
' -------------------------------- Début du SUB ----------------------------------
RetVal = Shell("Taskkill /IM Excel.exe /F", 0)
End Sub


voila ma petite sub que j'appelle a chaque fois qu'il faut que je supprime des processus excell

seulement il supprime tout les proc actif ...

Webmaster http://www.federun.be

wanirb · Answer

oui bien sure, je dit c compliquer en essayant de comprendre le code de la fonction. Par contre l'utilisation de la fonction est tres simple.

en tt cas je te remercie enormement pour ce coup de point, et ça marche plus au moins très bien car comme tu le dit elle kill tout les processus excel active.

à +

j_bus · Answer

sauriez vous si ca marche pour tuer un processus qui n'est pas excel mais juste un .exe qui apparait dans le gestionnaire des taches? merci.

carnez · Answer

taskkill ne fonctionne pas sous W2000; je ne possède pas cet exe

mais l'autre procédure, très longue et compliquée j'en conviens, fonctionne sous W2000 et Access 2002

il suffit de tester si un proccessus tourne, et si ce n'est pas normal, d'appeler la fonction 
killprocessus("WORD.EXE") par exemple, ou tout autre EXE que tu vois dans le gestionnaire des taches

Attention : ca tuera TOUS les processus de Word par exemple
Il vaut mieux afficher un message " si word et ouvert, fermer le sinon, cliquez sur OK"

Colibri

nepheris · Answer

Je debute en vba et je n'arriva pas a faire fonctionner ce code  que je souhaiterai utiliser pour fermer des proc&#233;ssus word. 

Boujour, 

Les 2 codes ci-dessous ne fonctionnnent pas ! 
Ce code est il compatible avec VBA ? 

Sub SuppProcDOC()
' Permet d'effacer tout les processus actif Word
Dim RetVal As Variant
RetVal = Shell("Taskkill /IM WINWORD.exe /F", 0)
End Sub

et 

Sub killWORD()
killprocessus ("WINWORD.EXE")
End Sub

Merci de votre aide 


Nepheris *

Fermeture d'un Processus excel sous VB6

8 réponses

Discussions similaires