'---------------------------------------------------------------
Public Function ADOObjectPermissions(strCnnPermissions As String, strAccessSystemTable As String, bolReadData As Boolean) As Boolean
'---------------------------------------------------------------
'Requires reference for Microsoft ADO Ext. 2.? for DDL and Security
'Add read data permission on table, ie MSysObjects, MSysRelationships, Emp Task
'ADOObjectPermissions("Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:\Program Files\SSW Upsizing PRO\Sample\TestReadPermissions.mdb","MSysObjects", True)
'Date          27/09/2002 ST
'Master SSW Upsizing PRO

On Error GoTo Err_ADOObjectPermissions

ADOObjectPermissions = False

'Open the catalog
Dim cat As New ADOX.Catalog
cat.ActiveConnection = strCnnPermissions & ";" & "Jet OLEDB:System database=" & _
        CurrentProject.Connection.Properties("Jet OLEDB:System Database").Value

Dim lngPerm As Long
lngPerm = cat.Users("admin").GetPermissions(strAccessSystemTable, adPermObjTable)
If lngPerm = 0 Or lngPerm = 1024 Or lngPerm = 148480 Then
    If bolReadData Then
        'add read data permission
        cat.Users("Admin").SetPermissions strAccessSystemTable, adPermObjTable, _
          adAccessSet, lngPerm Or adRightRead
    ElseIf Not bolReadData Then
        'add modify design permission to write table/field name
        cat.Users("Admin").SetPermissions strAccessSystemTable, adPermObjTable, _
          adAccessSet, lngPerm Or adRightUpdate
    Else
        MsgBox "logic error", vbCritical + vbOKOnly, "Validation in ADOObjectPermissions"
    End If
    
ElseIf lngPerm <> 0 Or lngPerm <> 1024 Then
    'ignore all
Else
    MsgBox "logic error", vbCritical + vbOKOnly, "Valiadtion in function ADOObjectPermissions"
End If

ADOObjectPermissions = True

Exit_ADOObjectPermissions:
    Set cat = Nothing
    Exit Function
Err_ADOObjectPermissions:
    MsgBox "Error: " & Err.Number & " -- " & Err.Description, vbCritical + vbOKOnly, "ADOObjectPermissions"
    Resume Exit_ADOObjectPermissions
    Resume
End Function