Исходный текст
Option Explicit
Call FindGroup("ALL_USERS")
'==============================================================================
' Вывести количество групп пользователей и проверить наличие группы c заданным
' системным именем;если не найдено - создать ее. Добавить пустую группу.
'==============================================================================
Sub FindGroup(GroupSysName)
Dim NewGroup, Groups, RetVal, Users, user
Dim TestGroup as new TDMSGroup
'Получить ссылку на коллекцию групп пользователей приложения
Set Groups = ThisApplication.Groups
ThisApplication.AddNotify "В приложении создано " & Groups.Count & " групп пользователей."
If Groups.Has(GroupSysName) Then
ThisApplication.AddNotify "Группа " & GroupSysName & " имеет в коллекции индекс "_
& Groups.Index(GroupSysName)
Else
If ThisApplication.Root.Objects(0).Permissions.SysAdmin <> TRUE Then
MsgBox "Для создания группы ""Все пользователи"" необходимо иметь права сисадмина.", _
vbExclamation
Exit Sub
End If
'Запросить у пользователя разрешение на создание новой группы
RetVal = MsgBox("Создать группу ""Все пользователи""?", vbQuestion + vbYesNo)
If RetVal <> vbYes Then Exit Sub 'если не согласился, выйти из процедуры
'Создать новую группу с заданным системным именем, присвоить ей описание и пользователей
Set NewGroup = Groups.Create
NewGroup.SysName = GroupSysName
NewGroup.Description = "Все пользователи (тест)"
Set Users = NewGroup.Users
For Each user In ThisApplication.Users
Users.Add user
Next
ThisApplication.AddNotify "Группа " & GroupSysName & " создана под номером " &_
ThisApplication.Groups.Index(NewGroup)
'Добавить тестовую группу
TestGroup.SysName = GroupTestSysName
TestGroup.Description = "Тестовая группа (пустая)"
NewGroup.Add TestGroup
End If
End Sub
'==============================================================================