Sleeper: Check IF Process Running

[EricM]

IS it possible to check to see if a proccess is runnning and then if the process is running to put a True or YEs into a cell?

[Jacob Hilderbrand]

What process do you want to check?

[mark007]

Yes, see the function I gave you in this thread (http://www.vbaexpress.com/forum/showthread.php?p=20766#post20766) called CheckProcess.

:)

[EricM]

Here is the spreadsheet I am working with. You need to be on a citrix server if not there will be a error when you open it. When it gets the session information I want it to see if that session has prowin32.exe running and return Yes or No. Ultimately when down I want to be able to track what users are consistantly disconnected.



Private Sub Workbook_Open()
Dim theFarm As MetaFrameFarm
Dim aSession As MetaFrameSession
Dim SessionState(10) As String
Dim intResult, intActiveSessions, intDisconnSessions As Integer
Dim intUniqueUsers, intSessions As Integer
Dim strTime As String
Dim timeNow As Date
Dim WB As Workbook
Dim WSAll, WSSessions, WSActive, WSDisconn, WSUsers As Worksheet
Dim intRowNum As Integer
' Get current date and time and store in "file name friendly" format.
timeNow = Now()
strTime = Month(timeNow) & "-" & Day(timeNow) & "-" & Year(timeNow) & _
"-" & Hour(timeNow) & "-" & Minute(timeNow)
' Create MetaFrameFarm object
Set theFarm = CreateObject("MetaFrameCOM.MetaFrameFarm")
If Err.Number <> 0 Then
MsgBox "Can't create MetaFrameFarm object" & _
"(" & Err.Number & ") " & Err.Description
End
End If
' Initialize the farm object.
theFarm.Initialize (MetaFrameWinFarmObject)
If Err.Number <> 0 Then
MsgBox "Can't Initialize MetaFrameFarm object" & "(" & Err.Number & _
") " & Err.Description
End
End If
' Are you Citrix Administrator?
If theFarm.WinFarmObject.IsCitrixAdministrator = 0 Then
MsgBox "You must be a Citrix administrator to run this application"
End
End If
SessionState(0) = "Unknown"
SessionState(1) = "Connected"
SessionState(2) = "Active"
SessionState(3) = "Connecting"
SessionState(4) = "Shadowing"
SessionState(5) = "Disconnected"
SessionState(6) = "Idle"
SessionState(7) = "Listening"
SessionState(8) = "Resetting"
SessionState(9) = "Down"
SessionState(10) = "Init"
' We want 5 worksheets in a new workbook
Application.SheetsInNewWorkbook = 5
Set WB = Application.Workbooks.Add
' Rename first Worksheet to All
Set WSAll = WB.Worksheets(1)
WSAll.Name = "All"
' Rename second worksheet to Sessions for displaying unique sessions only.
Set WSSessions = WB.Worksheets(2)
WSSessions.Name = "Sessions"
' Rename third worksheet to Active for displaying active sessions only.
Set WSActive = WB.Worksheets(3)
WSActive.Name = "Active"
' Rename fourth worksheet Disconn for displaying disconnected sessions only.
Set WSDisconn = WB.Worksheets(4)
WSDisconn.Name = "Disconn"
' Rename fifth worksheet Users for displaying distinct users only.
Set WSUsers = WB.Worksheets(5)
WSUsers.Name = "Users"
'Application.Visible = True
' Write Header to Excel Worksheet
WSAll.Cells(1, 1).Value = "User"
WSAll.Cells(1, 2).Value = "ServerName"
WSAll.Cells(1, 3).Value = "SessionID"
WSAll.Cells(1, 4).Value = "SessionName"
WSAll.Cells(1, 5).Value = "ClientName"
WSAll.Cells(1, 6).Value = "AppName"
WSAll.Cells(1, 7).Value = "SessionState"
WSAll.Cells(1, 8).Value = "ProWinRunning"
' Set current row to header row
intRowNum = 1
For Each aSession In theFarm.Sessions
If Err.Number <> 0 Then
MsgBox "Can't enumerate sessions" & vbCrLf & _
"(" & Err.Number & ") " & Err.Description
End
End If
intRowNum = intRowNum + 1
WSAll.Cells(intRowNum, 1).Value = aSession.UserName
WSAll.Cells(intRowNum, 2).Value = aSession.ServerName
WSAll.Cells(intRowNum, 3).Value = aSession.SessionID
WSAll.Cells(intRowNum, 4).Value = aSession.SessionName
WSAll.Cells(intRowNum, 5).Value = aSession.ClientName
WSAll.Cells(intRowNum, 6).Value = aSession.AppName
WSAll.Cells(intRowNum, 7).Value = SessionState(aSession.SessionState)
' WSAll.Cells(intRowNum, 8).Value =
Next
' Sort worksheet
WSAll.Columns("A:H").Sort WSAll.Columns("A"), xlAscending, _
WSAll.Columns("B"), , xlAscending, WSAll.Columns("C"), xlAscending, xlYes
' Autoformat to change column widths
WSAll.Columns("A:H").AutoFit
' Change header to bold font
WSAll.Range("A1:H1").Font.Bold = True
' Filter out duplicate records
' expression.AdvancedFilter(Action, CriteriaRange, CopyToRange, Unique)
WSAll.Columns("A:H").AdvancedFilter xlFilterInPlace, , , True
' Copy WSAll to WSSessions
WSAll.Columns("A:H").Copy (WSSessions.Cells(1, 1))
WSSessions.Columns("A:H").AutoFit
' Get number of Sessions
intSessions = Application.CountA(WSSessions.Range("A:A")) - 1
' Filter Sessions Worksheet for Active sessions only.
WSSessions.Range("A1").AutoFilter 7, "Active"
' Copy WSSessions to WSActive
WSSessions.Columns("A:H").Copy (WSActive.Cells(1, 1))
WSActive.Columns("A:H").AutoFit
' Get number of Active Sessions
intActiveSessions = Application.CountA(WSActive.Range("A:A")) - 1
' Show all data in WSSessions
WSSessions.ShowAllData
WSSessions.AutoFilterMode = False
' Filter Sessions Worksheet for Disconnected sessions only.
WSSessions.Range("A1").AutoFilter 7, "Disconnected"
' Copy WSSessions to WSDisconn
WSSessions.Columns("A:H").Copy (WSDisconn.Cells(1, 1))
WSDisconn.Columns("A:H").AutoFit
' Get number of Disconnected Sessions
intDisconnSessions = Application.CountA(WSDisconn.Range("A:A")) - 1
' Show all data in WSSessions
WSSessions.ShowAllData
WSSessions.AutoFilterMode = False
' Filter WSActive so only unique users are shown
WSActive.Columns("A").AdvancedFilter xlFilterInPlace, _
WSActive.Columns("A"), , True
' Copy unique users from WSActive to WSUsers
' We only copy first row
WSActive.Columns("A").Copy (WSUsers.Cells(1, 1))
WSUsers.Columns("A").AutoFit
' Get number of unique users
intUniqueUsers = Application.CountA(WSUsers.Range("A:A")) - 1
WB.SaveAs "UserLoad-" & theFarm.FarmName & "-" & strTime & ".xls"
MsgBox theFarm.FarmName & vbCrLf & _
timeNow & vbCrLf & vbCrLf & _
"Total Sessions: " & vbTab & intSessions & vbCrLf & _
"Active: " & vbTab & vbTab & intActiveSessions & vbCrLf & _
"Disconnected: " & vbTab & intDisconnSessions & vbCrLf & _
"Users: " & vbTab & vbTab & intUniqueUsers
End Sub