香港新浪網 MySinaBlog
« 上一篇 | 下一篇 »
Emily | 5th Dec 2006, 20:37 PM | Script | (1293 Reads)

WMI Example: Win32_Process (3)

Excellent Example: List All Running Processes

 

Sub List_All_Processes_Running()

' Set Reference to Microsoft Forms 2.0 Object Library

'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:D1").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

'

mySinaBlog 不支援斜線,斜線現用全形\取代 ,請改回。