Task manager’s system CPU PercentProcessorTime

P

Poniente

Can anyone help me reproduce the values in the CPU column of the tab
‘processes’ of the Windows task manager in excel?
I’d like to integrate these values in the code below, which lists the
active processes.
Unfortunately, the line ‘objProcess.PercentProcessorTime’ does not
work.

Your help is appreciated!
Poniente

Sub OwnerOfProcesses()
Dim objWMIService As Object
Dim colProcessList As Object
Dim objProcess As Object
Dim strNameOfUser As Variant
Dim strUserDomain As Variant
Dim colProperties As String
Dim MyList() As Variant
Dim x As Long

Set objWMIService = GetObject(strWmgt)
Set colProcessList = objWMIService.ExecQuery(strWmiQ)

x = colProcessList.Count

ReDim MyList(0 To (x - 1), 0 To 4)
On Error Resume Next
x = 0
For Each objProcess In colProcessList
colProperties = objProcess.GetOwner(strNameOfUser, strUserDomain)
MyList(x, 0) = objProcess.Name
MyList(x, 1) = strUserDomain
MyList(x, 2) = strNameOfUser
MyList(x, 3) = objProcess.handle
MyList(x, 4) = objProcess.PercentProcessorTime ‘ Help requested:
this line generates an error
x = x + 1
Next
Range("Log_Processes").Resize(x, 5).Value = MyList
Set objWMIService = Nothing 'JBC
Set colProcessList = Nothing 'JBC
Set objProcess = Nothing 'JBC
End Sub
 
M

Michel Pierron

Hi Poniente;
Adapt something like:

Sub Test()
Const strComputer$ = "."
Dim objWMIService As Object, colProcess As Object, objItem As Object
Dim Ret$, strNameOfUser, strUserDomain, i%: i = 1
Cells.Clear
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colProcess = objWMIService.ExecQuery("Select * " _
& "from Win32_PerfFormattedData_PerfProc_Process", , 48)
Cells(1, 1) = "Process Name"
Cells(1, 2) = "CPU Usage"
Cells(1, 3) = "Process ID"
Cells(1, 4) = "User name"
Cells(1, 5) = "Domain"
For Each objItem In colProcess
If objItem.Name <> "Idle" And objItem.Name <> "_Total" Then
i = i + 1
Cells(i, 1) = objItem.Name
Cells(i, 2) = objItem.PercentProcessorTime
Cells(i, 3) = objItem.IDProcess
End If
Next
Set colProcess = objWMIService.ExecQuery("Select * from Win32_Process")
For Each objItem In colProcess
i = RowFind(ActiveSheet, 3, objItem.ProcessID, True)
If i Then
Ret = objItem.GetOwner(strNameOfUser, strUserDomain)
Cells(i, 4) = strNameOfUser
Cells(i, 5) = strUserDomain
End If
Next
Set colProcess = Nothing
Set objWMIService = Nothing
Columns("A:E").Columns.AutoFit
End Sub

Private Function RowFind(Sh As Worksheet, ByVal Col As Byte, What As
Variant, Whole As Boolean) As Long
Dim Word As Range, Who As Byte
If Whole Then Who = 1 Else Who = 2
Set Word = Sh.Columns(Col).Find(What, LookAt:=Who)
If Not Word Is Nothing Then RowFind = Word.Row
End Function

MP

"Poniente" <[email protected]> a écrit dans le message de
Can anyone help me reproduce the values in the CPU column of the tab
‘processes’ of the Windows task manager in excel?
I’d like to integrate these values in the code below, which lists the
active processes.
Unfortunately, the line ‘objProcess.PercentProcessorTime’ does not
work.

Your help is appreciated!
Poniente

Sub OwnerOfProcesses()
Dim objWMIService As Object
Dim colProcessList As Object
Dim objProcess As Object
Dim strNameOfUser As Variant
Dim strUserDomain As Variant
Dim colProperties As String
Dim MyList() As Variant
Dim x As Long

Set objWMIService = GetObject(strWmgt)
Set colProcessList = objWMIService.ExecQuery(strWmiQ)

x = colProcessList.Count

ReDim MyList(0 To (x - 1), 0 To 4)
On Error Resume Next
x = 0
For Each objProcess In colProcessList
colProperties = objProcess.GetOwner(strNameOfUser, strUserDomain)
MyList(x, 0) = objProcess.Name
MyList(x, 1) = strUserDomain
MyList(x, 2) = strNameOfUser
MyList(x, 3) = objProcess.handle
MyList(x, 4) = objProcess.PercentProcessorTime ‘ Help requested:
this line generates an error
x = x + 1
Next
Range("Log_Processes").Resize(x, 5).Value = MyList
Set objWMIService = Nothing 'JBC
Set colProcessList = Nothing 'JBC
Set objProcess = Nothing 'JBC
End Sub
 
P

Poniente

Thanks Michel, that works really well! Exactly what I was looking for!

Do you happen to know how to get the process handle from an active
application?
I tried:
Application.hwnd

but my impression is that this does not match the 'ProcessID' output
of your code...

Any chance you can help me out on this one as well?


Best regards,
Poniente
 
M

Michel Pierron

Hi Poniente,

Explanation:
A program or application is a set of processes.
A process is a part of a program or application (the "Process handle" or
"Process ID" is the same).
A handle is not an address in memory. It's called a handle because it's
opaque. It's an indirect index into the process handle table, which in turn
contains the pointer to the kernel data structure; usually, a process
contains a lot of handles, which include the one corresponding to the
application.
See below, the "Test" procedure with the added property "Handle Count" and
the Details procedure.

Sub Test()
Const strComputer$ = "."
Dim objWMIService As Object, colProcess As Object, objItem As Object
Dim Ret$, strNameOfUser, strUserDomain, i%: i = 1
Cells.Clear
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colProcess = objWMIService.ExecQuery("Select * " _
& "from Win32_PerfFormattedData_PerfProc_Process", , 48)
Cells(1, 1) = "Process Name"
Cells(1, 2) = "CPU Usage"
Cells(1, 3) = "Process ID"
Cells(1, 4) = "User name"
Cells(1, 5) = "Domain"
Cells(1, 6) = "Handle count"
For Each objItem In colProcess
If objItem.Name <> "Idle" And objItem.Name <> "_Total" Then
i = i + 1
Cells(i, 1) = objItem.Name
Cells(i, 2) = objItem.PercentProcessorTime
Cells(i, 3) = objItem.IDProcess
End If
Next
Set colProcess = objWMIService.ExecQuery("Select * from Win32_Process")
For Each objItem In colProcess
i = RowFind(ActiveSheet, 3, objItem.ProcessID, True)
If i Then
Ret = objItem.GetOwner(strNameOfUser, strUserDomain)
Cells(i, 4) = strNameOfUser
Cells(i, 5) = strUserDomain
Cells(i, 6) = objItem.HandleCount ' Added
End If
Next
Set colProcess = Nothing
Set objWMIService = Nothing
Columns("A:E").Columns.AutoFit
End Sub

Private Function RowFind(Sh As Worksheet, ByVal Col As Byte _
, What As Variant, Whole As Boolean) As Long
Dim Word As Range, Who As Byte
If Whole Then Who = 1 Else Who = 2
Set Word = Sh.Columns(Col).Find(What, LookAt:=Who)
If Not Word Is Nothing Then RowFind = Word.Row
End Function

Statements at the beginning of module:
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" _
(ByVal hwnd As Long, lpdwProcessId As Long) As Long
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess _
As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long

Sub Details()
Const PROCESS_ALL_ACCESS = &H1F0FFF
On Error GoTo 1
Dim hwnd&, PID&, Handle&, Info$
'hwnd = Application.hwnd
hwnd = FindWindow(vbNullString, Application.Caption)
If hwnd Then
Info = "Application handle: " & hwnd
GetWindowThreadProcessId hwnd, PID
If PID Then
Info = Info & vbLf & "PID: " & PID
Handle = OpenProcess(PROCESS_ALL_ACCESS, False, PID)
Info = Info & vbLf & "Process handle: " & Handle
End If
End If
MsgBox Info, 64
Exit Sub
1: MsgBox "Error: " & Err.Number & vbLf & Err.Description & " !", 64
End Sub

Best regards,
MP
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Get CPU Priority of a ProcessID 2
Convert Macro to custom function 2
Returning values listed under multiple conditions 6
Seconds missing from time/date properties 2
Adapt this Directory Listing working code to insert a file namepattern prompt. 1
user defined type not defined issue 2
Please help with VBA Code! 0
Application_defined or object-defined error - Run 1004 error 3

Top