Copy all entries and roles from the ACL of one database to the ACL of another.
Has to be a time saver!
Option Public
Option Declare
Declare Function NEMGetFile Lib "nnotesws" ( wUnk As Integer, Byval szFileName
As String, Byval szFilter As String, Byval szTitle As String ) As Integer
Sub Initialize
'This Agent will refresh the design on all specified databases and verify the
ACL is configured correctly.
Dim SrcDB As NotesDatabase
Dim DestDB As NotesDatabase
Dim SrcDBName As String
Dim DestDBName As String
Dim done As Variant
SrcDBName = getFileName ("Select Source Database")
If SrcDBName = "" Then Done = True
If Not Done Then
DestDBName = getFileName ("Select Destination Database")
If DestDBName = "" Then Done = True
If Not Done Then
Set SrcDB = New NotesDatabase("",SrcDBName)
Set DestDB = New NotesDatabase("",DestDBName)
If SrcDB.Title = "" Or DestDB.Title = "" Then
Messagebox "Could not get one of the DBs"
Else
ConfirmACL SrcDB,DestDB
End If
End If
End If
End Sub
Sub ConfirmACL(SrcDB As NotesDatabase, DestDB As NotesDatabase)
Dim SrcACL As NotesACL
Dim DestACL As NotesACL
Dim Entry As NotesACLEntry
Dim NEntry As NotesACLEntry
Dim Roles As Variant
Dim TRoles As Variant
Dim Found As Variant
Dim I As Integer, J As Integer
Set SrcACL = SrcDB.ACL
Set DestACL = DestDB.ACL
SyncACLRoles SrcACL,DestACL
Set Entry = SrcACL.GetFirstEntry
While Not Entry Is Nothing
Set NEntry = DestACL.CreateACLEntry(Entry.Name, Entry.Level)
NEntry.CanCreateDocuments = Entry.CanCreateDocuments
NEntry.CanCreatePersonalAgent = Entry.CanCreatePersonalAgent
NEntry.CanCreatePersonalFolder = Entry.CanCreatePersonalFolder
NEntry.CanDeleteDocuments = Entry.CanDeleteDocuments
NEntry.IsPublicReader = Entry.IsPublicReader
NEntry.IsPublicWriter = Entry.IsPublicWriter
SyncEntryRoles NEntry, Entry, DestACL
Set Entry = SrcACL.GetNextEntry(Entry)
Wend
DestACL.Save
End Sub
Sub SyncACLRoles(SrcACL As NotesACL, DestACL As NotesACL)
Dim Roles As Variant
Dim TRoles As Variant
Dim Found As Variant
Dim i As Integer, j As Integer
Roles = DestACL.Roles
TRoles = SrcACL.Roles
For i = 0 To Ubound(TRoles)
If TRoles(i) <> "" Then
Found = False
For j = 0 To Ubound(Roles)
If Roles(j) <> "" Then
If TRoles(i) = Roles(j) Then
found = True
Exit For
End If
End If
Next j
If Not Found Then
DestACL.AddRole Mid$(TRoles(i),2,Len(TRoles(i))-2)
End If
End If
Next i
DestACL.Save
End Sub
Sub SyncEntryRoles(NEntry As NotesACLEntry, Entry As NotesACLEntry, ACL As
NotesACL)
Dim ACLRoles As Variant
Dim TRoles As Variant
Dim i As Integer, j As Integer
ACLRoles = ACL.Roles
TRoles = Entry.Roles
For i = 0 To Ubound(ACLRoles)
If ACLRoles(i) <> "" Then
For j = 0 To Ubound(TRoles)
If TRoles(j) <> "" Then
If ACLRoles(i) = TRoles(j) Then
NEntry.EnableRole
Mid$(ACLRoles(i),2,Len(ACLRoles(i))-2)
Exit For
Else
NEntry.DisableRole
Mid$(ACLRoles(i),2,Len(ACLRoles(i))-2)
End If
End If
Next
End If
Next
End Sub<WHA
This was first published in November 2000