Setting User Permissions for an Object

 
Sub Set_UserObjectPermissions() 
    Dim conn As ADODB.Connection 
    Dim cat As ADOX.Catalog 
    Dim strDB As String 
    Dim strSysDb As String 

    On Error GoTo ErrorHandle 

    strDB = CurrentProject.Path & "\mydb.mdb" 
    strSysDb = CurrentProject.Path & "\mydb.mdw" 

    Set conn = New ADODB.Connection 
        With conn 
            .Provider = "Microsoft.Jet.OLEDB.4.0" 
            .Properties("Jet OLEDB:System Database") = strSysDb 
            .Properties("User ID") = "Developer" 
            .Properties("Password") = "mypass" 
            .Open strDB 
        End With 

    Set cat = New ADOX.Catalog 
    cat.ActiveConnection = conn 
    cat.Users.Append "PowerUser", "star" 

    cat.Users("PowerUser").SetPermissions "Customers", _ 
        adPermObjTable, _ 
        adAccessSet, _ 
        adRightRead Or _ 
        adRightInsert Or _ 
        adRightUpdate Or _ 
        adRightDelete 

ExitHere: 
    Set cat = Nothing 
    conn.Close 
    Set conn = Nothing 
    Exit Sub 
ErrorHandle: 
    If Err.Number = -2147467259 Then 
        Debug.Print "PowerUser user already exists." 
        Resume Next 
    Else 
        Debug.Print Err.Description 
        Resume ExitHere 
    End If 
End Sub

Related examples in the same category

1.	Enumerate group and users
2.	Add a new user
3.	Creating a User Account
4.	Deleting a User Account
5.	Listing All User Accounts
6.	Retrieving the Name of the Object Owner
7.	Creating a User Account with SQL command
8.	Changing a User Password with SQL command
9.	Setting User Permissions for a Database
10.	Setting User Permissions for Containers
11.	Checking Permissions for a Specific Object

Setting User Permissions for an Object : User Account « Access « VBA / Excel / Access / Word

Related examples in the same category