**************************************************************************************

  Security (show "no delete" permissions)

************************************************************************************

ub ShowNoDelPerms()

Dim objContainer As Container

Dim objDoc As Document

For Each objContainer In CurrentDb.Containers

    Debug.Print "--> Container: " & objContainer.Name

    For Each objDoc In objContainer.Documents

        If objDoc.AllPermissions And dbSecDelete Then

            Debug.Print "Can Delete Document: " & _

            objDoc.Name & "  ";

            objDoc.UserName = "Admin"

            Debug.Print "Perms: " & objDoc.AllPermissions

        Else

            Debug.Print "Cannot Delete Document: " & _

            objDoc.Name & "  ";

            objDoc.UserName = "Admin"

            Debug.Print "Perms: " & objDoc.AllPermissions

        End If

    Next

Next

Debug.Print "Done"

End Sub

*************************************************************************************

  Security (listing permissions)

***********************************************************************************

Sub ShowPerms()

Dim objContainer As Container

Dim objDoc As Document

For Each objContainer In CurrentDb.Containers

    Debug.Print "--> Container: " & objContainer.Name

    For Each objDoc In objContainer.Documents

        Debug.Print "Document: " & objDoc.Name & "  ";

        objDoc.UserName = "Admin"

        Debug.Print "Perms: " & objDoc.AllPermissions

    Next

Next

Debug.Print "Done"

End Sub

************************************************************************************

Security (adding User to Group)

************************************************************************************

Sub AddUserToGroup()

Dim wks As Workspace

Dim usrMark As User

Dim grpRegistrars As Group

Set wks = DBEngine(0)

Set usrMark = wks.CreateUser("Mark Fenton")

wks.Groups("Registrars").Users.Append usrMark

End Sub

                                                **** Alternative example **************

'Creates a new user and appends it to the user collecton.

'Appends that user to the Users and Managers groups

Sub CreateNewUser()

    Dim ws As Workspace

    Dim newUsr As User

    Set ws = DBEngine.Workspaces(0)

    Set newUsr = ws.CreateUser("A_Manager", "1234", "myPassword")

    ws.Users.Append newUsr

    With newUsr.Groups

        .Append ws.CreateGroup("Users")

        .Append ws.CreateGroup("Managers")

        .Refresh

    End With

End Sub

******************************************************************************************************

  Security (adding a Group Account)

******************************************************************************************************

Sub GroupAdd()

Dim wks As Workspace

Dim grpRegistrars As Group

Dim strGroupPID As String

Set wks = DBEngine(0)

strGroupPID = "5678"

'Start by creating a new Group account

Set grpRegistrars = wks.CreateGroup("Registrars")

'Now set the Group's properties

grpRegistrars.PID = strGroupPID

'Append Group to the Groups collection of this workspace

wks.Groups.Append grpRegistrars

End Sub

                                                ******** Alternative example ***********

'Create a new group called Managers

Sub CreateNewGroup()

    Dim ws As Workspace

    Dim newGrp As Group

    Set ws = DBEngine.Workspaces(0)

    Set newGrp = ws.CreateGroup("Managers", "1234")

    With ws.Groups

        .Append newGrp

        .Refresh

    End With

End Sub

******************************************************************************************************

  Security (adding a new User Account)

******************************************************************************************************

Sub UserAdd()

Dim wks As Workspace

Dim usrMark As User

Dim strUsersPID As String

Set wks = DBEngine(0)

strUsersPID = "1234abcd"

'Start by creating a new User account

Set usrMark = wks.CreateUser("Mark Fenton")

'Now set the User's properties

usrMark.Password = "Doctor"

usrMark.PID = strUsersPID

'Append User to the Users collection of this workspace

wks.Users.Append usrMark

End Sub

******************************************************************************************************