Некоторое время назад я спросил о ограничении числа экземпляров Excel, одновременно запускаемых в Windows .
Благодаря помощи, которую я получил на StackOverflow.com, я смог собрать следующую функцию, которая закрывает любой запущенный экземпляр Excel, если уже запущен другой экземпляр Excel.
Private Function KillDuplicateProcesses() As Boolean
Dim objWMIService As Object
Dim colItems As Variant
Dim objItem As Object
Dim intCount As Integer
Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
Set colItems = objWMIService.InstancesOf("Win32_Process")
For Each objItem In colItems
intCount = intCount + Abs(LCase(objItem.Name) = "excel.exe")
If intCount > 1 Then
MsgBox "Excel is already running." & vbCrLf & vbCrLf & _
"To open a file use " & IIf(Application.Version >= 12, "Office Button", "File") & " > Open (Ctrl + O).", vbCritical
KillDuplicateProcesses = True
Application.Quit
Exit For
End If
Next
End Function
Проблема заключается в том, что если пользователь вошел в сеанс удаленного рабочего стола как администратор, эта учетная запись пользователя может видеть всех других пользователей и процессы, которые они выполняют. Поэтому, если другой пользователь вошел в систему на том же компьютере и работает с Excel, функция также подсчитывает эти экземпляры и закрывает только что запущенный экземпляр Excel.
Мне нужно ограничить область действия этой функции текущим сеансом. Согласно документации MSDN существует свойство класса, называемое SessionID. Могу ли я использовать это свойство и сравнить его с идентификатором текущего сеанса, чтобы ограничить счет функции или есть лучший способ сделать это?
Любые предложения будут с благодарностью.
Спасибо!
Ниже приведен код решения согласно предложению Тима. Примечание. Я сравниваю свойства GetOwner с Environ UserName и UserDomain. Environ считается ненадежным, поскольку он может быть изменен пользователем.
Private Function KillDuplicateProcesses() As Boolean
Dim objWMIService As Object
Dim colItems As Variant
Dim objItem As Object
Dim intCount As Integer
Dim strProcessUser As Variant
Dim strProcessDomain As Variant
Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
Set colItems = objWMIService.ExecQuery("SELECT * FROM Win32_Process WHERE Name = 'excel.exe'")
If colItems.Count > 1 Then
For Each objItem In colItems
strProcessUser = ""
strProcessDomain = ""
objItem.GetOwner strProcessUser, strProcessDomain
If IsNull(strProcessUser) Then strProcessUser = ""
If IsNull(strProcessDomain) Then strProcessDomain = ""
intCount = intCount + Abs(strProcessUser = Environ("UserName") _
And strProcessDomain = Environ("UserDomain"))
If intCount > 1 Then
MsgBox "You cannot run more than one instance of Excel while iTools is activated." & vbCrLf & vbCrLf & _
"To open a file use " & IIf(Application.Version >= 12, "Office Button", "File") & " > Open (Ctrl + O).", vbCritical
KillDuplicateProcesses = True
Application.Quit
Exit For
End If
Next
End If
End Function