Исходный код

Option Explicit
Call GiveRoleToUser(ThisObject, "ROLE_AGREE")


'==============================================================================
'Дать текущему пользователю указанную роль на указанном объекте 
'(если ее не было)
'==============================================================================
Sub GiveRoleToUser(Obj, RoleName)
        Dim Roles, RoleDef, NewRole, User
        
        'Если роль не существует в системе, сообщить об этом и выйти из процедуры
        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
        Else 
                MsgBox "Вы уже имеете роль ""Согласование"".", vbInformation
        End If
End Sub 
'==============================================================================