TUER UNE/DES SESSION(S) CACHÉE(S) D'EXCEL À PARTIR D'UNE AUTRE SESSION

'Macro Créée par : BigFish_le Vrai (Philippe E)
'le :06-08-2008
'V1.0
'
Option Explicit

    'API ouverture processus et ses constantes
    Public Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
    Public Const PROCESS_VM_READ As Long = (&H10)
    Public Const PROCESS_QUERY_INFORMATION As Long = (&H400)
    
    Public Declare Function GetCurrentProcessId Lib "kernel32.dll" () As Long
    Declare Function IsWindowVisible Lib "user32" (ByVal hwnd As Long) As Long
    Declare Function GetModuleFileNameEx Lib "psapi.dll" Alias "GetModuleFileNameExA" (ByVal hProcess As Long, ByVal hModule As Long, ByVal lpFilename As String, ByVal nSize As Long) As Long
    Declare Function EnumWindows Lib "user32" (ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
    Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
    Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
    Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
    Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
    
    Declare Function TerminateProcess Lib "kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long
    Const PROCESS_TERMINATE As Long = &H1
    
    Public Const MAX_PATH As Integer = 260
    
    Public hProcess As Long    'handle du processus
    Public bob As Long, CurrentProcessId As Long, ViewOnly As Boolean

Function EnumWinProc(ByVal lhWnd As Long, ByVal lParam As Long) As Long
    '-----------------------------------
    'enumeration des processus
    'renvoie du/des session(s) excel
    'Arret du/des Processus excel caché
    '-----------------------------------
    Dim RetVal As Long, ProcessID As Long, ThreadID As Long
    Dim WinClassBuf As String * 255, WinTitleBuf As String * 255
    Dim WinClass As String, WinTitle As String, NomExe As String
    
    ' see the Windows Class and Title for each top level Window
    RetVal = GetClassName(lhWnd, WinClassBuf, 255)
    WinClass = StripNulls$(WinClassBuf)  ' remove extra Nulls & spaces
    RetVal = GetWindowText(lhWnd, WinTitleBuf, 255)
    WinTitle = StripNulls$(WinTitleBuf)
    ' la fenetre(thread principale)est elle visible ?
    RetVal = IsWindowVisible(lhWnd)
    ' on recupere l'PID de la fenetre(thread principale)
    ThreadID = GetWindowThreadProcessId(lhWnd, ProcessID)
    ' on recupere le nom du thread principale
    NomExe = GetProcessFileName(ProcessID)
    With Worksheets("sheet1")
        If NomExe = "excel.exe" And WinTitle Like "Microsoft Excel*" = True Then
            ' ecriture des données sur la feuille
            .Range("A" & bob).Value = NomExe
            .Range("B" & bob).Value = ProcessID
            ' on converti le resultat binaire en booleen pour une meilleur lecture
            .Range("C" & bob).Value = CBool(RetVal * -1)
            .Range("D" & bob).Value = WinTitle
            ' si le processus est le processus courant
            ' on lui applique une mise en forme specifique
            If ProcessID = CurrentProcessId Then
                .Range("A" & bob & ":E" & bob).Interior.ColorIndex = 35
                .Range("E" & bob).Value = "Current"
            End If
            ' si le thread principale d'excel est invisible
            If RetVal = 0 Then
                .Range("A" & bob & ":E" & bob).Interior.ColorIndex = 44
                If ViewOnly = False Then
                    ' on arrete le processus
                    ' La fonction renvoie 1 si le processus c'est arrete
                    If CloseProcess(ProcessID) = 1 Then
                        .Range("E" & bob).Value = "Killed"
                    Else
                        MsgBox "le process n'a pas pu etre arreté ! ", vbExclamation
                    End If
                End If
            End If
            bob = bob + 1
        End If
    End With
    CloseHandle hProcess
    EnumWinProc = True
End Function

Public Function StripNulls(OriginalStr As String) As String
   ' This removes the extra Nulls so String comparisons will work
   If (InStr(OriginalStr, Chr(0)) > 0) Then
      OriginalStr = Left(OriginalStr, InStr(OriginalStr, Chr(0)) - 1)
   End If
   StripNulls = OriginalStr
End Function
      
' ---------------------------------------------
' Renvoie le Nom du processus
' ---------------------------------------------
' Parametre
' ProcessID : ID du processus
' ---------------------------------------------
' d'apres un code de    : MadMatt
' Titre d'origine       : Renvoie le chemin complet du processus
' Son Site Perso        : http://matthieu.napoli.free.fr
' Le site du code       : http://vbsystemlibrary.free.fr/code.php?ID=5
' ---------------------------------------------
Public Function GetProcessFileName(ByVal ProcessID As Long) As String
    ' Processus 0
    If ProcessID = 0 Then
        GetProcessFileName = "[System Process]"
    ' Processus 4
    ElseIf ProcessID = 4 Then
        GetProcessFileName = "System"
    Else
        ' On cherche son chemin d'accès complet
        'Dim hProcess As Long    'handle du processus
        Dim hModule As Long    'handle du module de l'exe
        Dim Ret As Long        'résultat
        ' On demande un handle pour le processus
        hProcess = OpenProcess(PROCESS_QUERY_INFORMATION Or PROCESS_VM_READ Or PROCESS_TERMINATE, 0&, ProcessID)
        ' Si erreur (accès refusé)
        If hProcess Then
            ' On préformate la chaine
            GetProcessFileName = Space(MAX_PATH)
            ' On récupère son nom complet
            GetModuleFileNameEx hProcess, 0, GetProcessFileName, MAX_PATH
            ' On ferme le handle ouvert
            'CloseHandle hProcess
            ' On retire le vbNUllChar de fin de chaine
            GetProcessFileName = Left(GetProcessFileName, InStr(GetProcessFileName, vbNullChar) - 1)
            'on extrait le nom de l'Image du processus
            GetProcessFileName = LCase(Right(GetProcessFileName, InStr(1, StrReverse(GetProcessFileName), "\") - 1))
            Exit Function
        ElseIf hProcess = 0 Then
            GetProcessFileName = vbNullString
        End If
    End If
End Function
' ---------------------------------------------
' Termine le processus
' ---------------------------------------------
Public Function CloseProcess(ProcessID As Long) As Long
    'fermeture du thread principal d'excel
    CloseProcess = TerminateProcess(hProcess, 0)
End Function

Télécharger le zip

04 septembre 2008 18:52:53 :

toute petite correction du code