I have written set of functions that use the ADO libraries in Access 2000 and later. I've found these far simpler than their DAO counterparts. There's no error trapping, but should be a starting point for you:
'Contains procedures to manage MS Access security via VB.
'Uses Jet 4 ANSI-92 extensions (for simplicity) accessible via SQL so will only work in
'MS Access 2000 or later.
'Also have to use ADO connections to run the SQL. CurrentDB.Execute runs in Jet3.6...
'... Connection.Execute runs in Jet 4 - what's that all about then???
'Written by Ed Metcalfe, 28/11/2002.
'Still need to add error trapping - need to learn ADO error object first.
Public Sub CreateUser(ByVal strUserName As String, ByVal strPWord As String, ByVal lngPID As Long)
Dim cnn As ADODB.Connection
Set cnn = CurrentProject.Connection
cnn.Execute "CREATE USER " & strUserName & " " & strPWord & " " & lngPID & ";"
'All users must be members of users group
Call AddToGroup(strUserName, "Users")
cnn.Close
Set cnn = Nothing
End Sub
Public Sub CreateGroup(ByVal strGroupName As String, ByVal lngGID As Long)
Dim cnn As ADODB.Connection
Set cnn = CurrentProject.Connection
cnn.Execute "CREATE GROUP " & strGroupName & " " & lngGID & ";"
cnn.Close
Set cnn = Nothing
End Sub
Public Sub ChangePass(ByVal strUserName As String, strNewPass As String, strOldPass As String)
Dim cnn As ADODB.Connection
Set cnn = CurrentProject.Connection
cnn.Execute "ALTER USER " & strUserName & " PASSWORD " & strNewPass & " " & strOldPass & ";"
cnn.Close
Set cnn = Nothing
End Sub
Public Sub AddToGroup(ByVal strUserName As String, ByVal strGroupName As String)
Dim cnn As ADODB.Connection
Set cnn = CurrentProject.Connection
cnn.Execute "ADD USER " & strUserName & " TO " & strGroupName & ";"
cnn.Close
Set cnn = Nothing
End Sub
Public Sub RemoveFromGroup(ByVal strUserName As String, ByVal strGroupName As String)
Dim cnn As ADODB.Connection
Set cnn = CurrentProject.Connection
cnn.Execute "DROP USER " & strUserName & " FROM " & strGroupName
cnn.Close
Set cnn = Nothing
End Sub
Public Sub DeleteUser(ByVal strUserName As String)
Dim cnn As ADODB.Connection
Set cnn = CurrentProject.Connection
cnn.Execute "DROP USER " & strUserName & ";"
cnn.Close
Set cnn = Nothing
End Sub
Public Sub DeleteGroup(ByVal strGroupName As String)
Dim cnn As ADODB.Connection
Set cnn = CurrentProject.Connection
cnn.Execute "DROP GROUP " & strGroupName & ";"
cnn.Close
Set cnn = Nothing
End Sub
Public Sub AssignPermission(ByVal strAction As String, ByVal strPermissionName As String, ByVal strObjectName As String, ByVal strObjectType As String, ByVal strAccountName As String)
'strAction - GRANT Or REVOKE
'strPermissionName - SELECT, DELETE, INSERT, UPDATE, DROP, SELECTSECURITY, UPDATESECURITY,
'DBPASSWORD, UPDATEIDENTITY, CREATE, SELECTSCHEMA, SCHEMA, UPDATEOWNER
'strObject Name - Name of table/form/report etc.
'strObjectType - "TABLE", "OBJECT" OR "CONTAINER"
'strAccountName - name of user or group
'How do you give design privs then??
Dim cnn As ADODB.Connection
Set cnn = CurrentProject.Connection
Select Case strAction
Case "GRANT"
cnn.Execute "GRANT " & strPermissionName & " ON " & strObjectType & " " & strObjectName & " TO " & strAccountName & ";"
Case "REVOKE"
cnn.Execute "REVOKE " & strPermissionName & " ON " & strObjectType & " " & strObjectName & " FROM " & strAccountName & ";"
End Select
cnn.Close
Set cnn = Nothing
End Sub
Ed Metcalfe.
Please do not feed the trolls.....
