Option Explicit
#If VBA7 Then
Private Declare PtrSafe Function apiGetClassName Lib "user32" Alias _
"GetClassNameA" (ByVal hwnd As Long, _
ByVal lpClassname As String, _
ByVal nMaxCount As Long) As Long
Private Declare PtrSafe Function apiGetDesktopWindow Lib "user32" Alias _
"GetDesktopWindow" () As Long
Private Declare PtrSafe Function apiGetWindow Lib "user32" Alias _
"GetWindow" (ByVal hwnd As Long, _
ByVal wCmd As Long) As Long
Private Declare PtrSafe Function apiGetWindowLong Lib "user32" Alias _
"GetWindowLongA" (ByVal hwnd As Long, ByVal _
nIndex As Long) As Long
Private Declare PtrSafe Function apiGetWindowText Lib "user32" Alias _
"GetWindowTextA" (ByVal hwnd As Long, ByVal _
lpString As String, ByVal aint As Long) As Long
Private Declare PtrSafe Function GetWindowThreadProcessId Lib "user32.dll" _
(ByVal hwnd As Long, ByRef lpdwProcessId As Integer) As Integer
Declare PtrSafe Function GetWindowModuleFileName Lib "user32.dll" Alias _
"GetWindowModuleFileNameA" (ByVal hwnd As Long, ByVal pszFileName As String, ByVal cchFileNameMax As Long) As Long
#Else
Private Declare Function apiGetClassName Lib "user32" Alias _
"GetClassNameA" (ByVal hwnd As Long, _
ByVal lpClassname As String, _
ByVal nMaxCount As Long) As Long
Private Declare Function apiGetDesktopWindow Lib "user32" Alias _
"GetDesktopWindow" () As Long
Private Declare Function apiGetWindow Lib "user32" Alias _
"GetWindow" (ByVal hwnd As Long, _
ByVal wCmd As Long) As Long
Private Declare Function apiGetWindowLong Lib "user32" Alias _
"GetWindowLongA" (ByVal hwnd As Long, ByVal _
nIndex As Long) As Long
Private Declare Function apiGetWindowText Lib "user32" Alias _
"GetWindowTextA" (ByVal hwnd As Long, ByVal _
lpString As String, ByVal aint As Long) As Long
Private Declare Function GetWindowThreadProcessId Lib "user32.dll" _
(ByVal hwnd As Long, ByRef lpdwProcessId As Integer) As Integer
Declare PtrSafe GetWindowModuleFileName Lib "user32.dll" Alias _
"GetWindowModuleFileNameA" (ByVal hwnd As Long, ByVal pszFileName As String, ByVal cchFileNameMax As Long) As Long
#End If
Private Const mcGWCHILD = 5
Private Const mcGWHWNDNEXT = 2
Private Const mcGWLSTYLE = (-16)
Private Const mcWSVISIBLE = &H10000000
Private Const mconMAXLEN = 255
'---------------------------------------------------------
'Liste les programmes de la barres des tâches et leurs PID
'---------------------------------------------------------
Sub Test_TaksBarTaskList()
Dim T() As Variant
Dim i As Integer
T = TaksBarTaskList
ActiveSheet.Range("A:A").ClearContents
For i = 1 To UBound(T, 1)
ActiveSheet.Range("A" & i) = T(i, 1) & ", PID = " & T(i, 2) & ", Module = " & T(i, 3)
Next i
End Sub
'------------------------------------------
'Retourne un tableau des tâches de la barre
'des tâches et de leurs Process ID associés
'------------------------------------------
Function TaksBarTaskList() As Variant
Dim lngx As Long
Dim lngLen As Long
Dim lngStyle As Long
Dim T() As Variant
Dim T1() As Variant
lngx = apiGetDesktopWindow()
'Return the first child to Desktop
lngx = apiGetWindow(lngx, mcGWCHILD)
Do While Not lngx = 0
T1 = GetInfo(lngx)
If Len(T1(1, 1)) > 0 Then
lngStyle = apiGetWindowLong(lngx, mcGWLSTYLE)
'enum visible windows only
If lngStyle And mcWSVISIBLE Then
If Not (Not T) Then
ReDim Preserve T(1 To 3, 1 To UBound(T, 2) + 1)
Else
ReDim T(1 To 3, 1 To 1)
End If
T(1, UBound(T, 2)) = T1(1, 1)
T(2, UBound(T, 2)) = T1(1, 2)
T(3, UBound(T, 2)) = T1(1, 3)
End If
End If
lngx = apiGetWindow(lngx, mcGWHWNDNEXT)
Loop
TaksBarTaskList = Application.Transpose(T)
End Function
Private Function GetInfo(hwnd As Long) As Variant
Dim strBuffer As String
Dim intCount As Integer
Dim ProcessId As Integer
Dim T1(1 To 1, 1 To 3) As Variant
strBuffer = String$(mconMAXLEN - 1, 0)
intCount = apiGetWindowText(hwnd, strBuffer, mconMAXLEN)
If intCount > 0 Then
T1(1, 1) = Left$(strBuffer, intCount)
Call GetWindowThreadProcessId(hwnd, ProcessId)
T1(1, 2) = ProcessId
intCount = GetWindowModuleFileName(hwnd, strBuffer, mconMAXLEN)
T1(1, 3) = Left$(strBuffer, intCount)
End If
GetInfo = T1
End Function
