Export (0) Print
Expand All
Expand Minimize

GetPermissions and SetPermissions Methods Example (VB)

This example demonstrates the GetPermissions and SetPermissions methods. The following code gives full access for the Orders table to the Admin user.

' BeginGrantPermissionsVB
Sub GrantPermissions()
    On Error GoTo GrantPermissionsError
    
    Dim cnn As New ADODB.Connection
    Dim cat As New ADOX.Catalog
    Dim lngPerm As Long

    ' Opens a connection to the northwind database
    ' using the Microsoft Jet 4.0 provider
    cnn.Provider = "Microsoft.Jet.OLEDB.4.0"
    cnn.Open "Data Source='Northwind.mdb';" & _
        "jet oledb:system database=" & _
        "'system.mdw'"

    Set cat.ActiveConnection = cnn

    ' Retrieve original permissions
    lngPerm = cat.Users("admin").GetPermissions("Orders", adPermObjTable)
    Debug.Print "Original permissions: " & Str(lngPerm)
    
    ' Revoke all permissions
    cat.Users("admin").SetPermissions "Orders", adPermObjTable, _
        adAccessRevoke, adRightFull
    
    ' Display permissions
    Debug.Print "Revoked permissions: " & _
        Str(cat.Users("admin").GetPermissions("Orders", adPermObjTable))
    
    ' Give the Admin user full rights on the orders object
    cat.Users("admin").SetPermissions "Orders", adPermObjTable, _
        adAccessSet, adRightFull

    ' Display permissions
    Debug.Print "Full permissions: " & _
        Str(cat.Users("admin").GetPermissions("Orders", adPermObjTable))

    ' Restore original permissions
    cat.Users("admin").SetPermissions "Orders", adPermObjTable, _
        adAccessSet, lngPerm

    ' Display permissions
    Debug.Print "Final permissions: " & _
        Str(cat.Users("admin").GetPermissions("Orders", adPermObjTable))
    
    'Clean up
    cnn.Close
    Set cat = Nothing
    Set cnn = Nothing
    Exit Sub
    
GrantPermissionsError:
    
    Set cat = Nothing
    
    If Not cnn Is Nothing Then
        If cnn.State = adStateOpen Then cnn.Close
    End If
    Set cnn = Nothing
    
    If Err <> 0 Then
        MsgBox Err.Source & "-->" & Err.Description, , "Error"
    End If
    
End Sub
' EndGrantPermissionsVB
Show:
© 2015 Microsoft