The following will list all Apps/Processes currently
running. Copy all to a module and let-her-rip (note: you
may need to do some clean up due to line wrapping in this
editor):
Sub List_All_Processes_Running()
'Prepare destination
Cells.Clear
[A1].Select
'Dimension arrays
Dim aProcessName()
Dim aBelongsTo()
Dim aProcessID()
'Create object variables
Set xWMIService = GetObject("WINMGMTS:
{IMPERSONATIONLEVEL=IMPERSONATE}!\\.\ROOT\CIMV2")
'Run query against WMI
Set xProcesses = xWMIService.ExecQuery("SELECT * FROM
WIN32_PROCESS")
'Initialize loop for each item in xProcesses
For Each xProcess In xProcesses
'Determine if the owner of the process can be
identified
If xProcess.GetOwner(User, Domain) = 0 Then
'Able to identify process owner
x = x + 1
ReDim Preserve aProcessName(x)
ReDim Preserve aBelongsTo(x)
ReDim Preserve aProcessID(x)
aProcessName(x) = xProcess.Caption
aBelongsTo(x) = Domain & "\" & User
aProcessID(x) = xProcess.ProcessID
Else
'Unable to identify process owner
x = x + 1
ReDim Preserve aProcessName(x)
ReDim Preserve aBelongsTo(x)
ReDim Preserve aProcessID(x)
aProcessName(x) = xProcess.Caption
aBelongsTo(x) = "Owner Unknown " & Domain & "\" &
User
aProcessID(x) = xProcess.ProcessID
End If
Next
'Write results
For x = 1 To UBound(aProcessName)
ActiveCell.Offset(x, 0).FormulaR1C1 = aProcessName (x)
ActiveCell.Offset(x, 1).FormulaR1C1 = aBelongsTo(x)
ActiveCell.Offset(x, 2).FormulaR1C1 = aProcessID(x)
ActiveCell.Offset(x, 3).FormulaR1C1 = UCase
(aProcessName(x))
Next x
'Format results
Range("A1
1").Value = Array("PROCESS", "BELONGS
TO", "PROCESSID", "NAME")
Rows(1).Font.Bold = True
Rows(1).HorizontalAlignment = xlCenter
ActiveWindow.SplitRow = 1
ActiveWindow.FreezePanes = True
Cells.Columns.AutoFit
For Each xCol In ActiveSheet.Columns
If xCol.ColumnWidth > 50 Then xCol.ColumnWidth = 50
Next xCol
'Clear objects from memory
Set xWMIService = Nothing
Set xProcesses = Nothing
End Sub