Исходный текст

Option Explicit
Call GiveRoleToUser(ThisObject, "ROLE_AGREE")


'==============================================================================
'Дать текущему пользователю указанную роль на указанном объекте 
'(если ее не было)
'==============================================================================
Sub GiveRoleToUser(Obj, RoleName)
        Dim Roles, RoleDef, NewRole, User
        
        'Если нет информации о ролях, выйти из процедуры
        If ThisApplication.RoleDefs.Count = 0 Then 
                MsgBox "Роли в системе отсутствуют.", _
                        vbInformation, "Информация о текущей настройке"
                Exit Sub
        End If
        
        'Если роль не существует в системе, сообщить об этом и выйти из процедуры
        If Not ThisApplication.RoleDefs.Has(RoleName) Then
                MsgBox "Роль """ & RoleName & """ не определена в системе.", vbExclamation
                Exit Sub
        End If
        
        'Получаем необходимые ссылки
            
        Set RoleDef = ThisApplication.RoleDefs(RoleName)
        Set User = ThisApplication.CurrentUser
        Set Roles = Obj.Roles
            
        'Создать роль на объекте, если ее там не было
        If Not Roles.Has("ROLE_AGREE") Then 
                Set NewRole = Roles.Create (RoleDef, User) ' добавляем роль к объекту
                MsgBox "Вы успешно назначены на роль ""Согласование"".", vbInformation
                ThisApplication.DebugPrint("Номер новой рооли в коллекции - " & Roles.Index(RoleDef))
        Else 
                MsgBox "Вы уже имеете роль ""Согласование"".", vbInformation
        End If
End Sub