Have you ever had to create an Excel spreadsheet detailing your ACL, and
then had to compare this to the required ACL?
This agent will create a two sheet spreadsheet of the current database ACL,
one sheet for the ACL and another containing the roles.
Code
'Declarations
'===============================
Dim xlApp As Variant
Dim xlWkBook As Variant
Dim sColumnCode As String
Const xlDiagonalDown=5
Const xlNone=-4142
Const xlDiagonalUp=6
Const xlEdgeBottom=9
Const xlEdgeLeft=7
Const xlEdgeRight=10
Const xlEdgeTop=8
Const xlAutomatic=-4105
Const xlContinuous=1
Const xlThin=2
Const xlInsideVertical=11
Const xlUnderlineStyleNone=-4142
Const xlPrintNoComments=-4142
Const xlLandscape=2
Const xlPaperA4=9
Const xlDownThenOver=1
'===================================
Sub Initialize
Dim s As New NotesSession
Dim db As NotesDatabase
Dim acl As NotesACL
Dim entry As NotesACLEntry
Dim row As Integer
Dim Col As Integer
Dim x As Integer
Dim RoleList List As Integer
Dim UserTypeList List As String
Dim AccessLevel List As String
Set db = s.currentdatabase
Set acl = db.ACL
row = 1
col = 1
UserTypeList(0) = "Unspecified"
UserTypeList(1) = "Person"
UserTypeList(2) = "Server"
UserTypeList(3) = "Mixed"
UserTypeList(4) = "Person Group"
UserTypeList(5) = "Server Group"
AccessLevel(0) = "No Access"
AccessLevel(1) = "Depositor"
AccessLevel(2) = "Reader"
AccessLevel(3) = "Author"
AccessLevel(4) = "Editor"
AccessLevel(5) = "Designer"
AccessLevel(6) = "Manager"
'Create Spreadsheet titles
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = True
Set xlWkBook = xlApp.Workbooks
xlWkBook.Add
xlApp.Application.DisplayAlerts = False
xlApp.Sheets("Sheet1").Select
xlApp.Sheets("Sheet1").Name = "ACL"
xlApp.Sheets("Sheet2").Select
xlApp.Sheets("Sheet2").Name = "Roles"
xlApp.Sheets("Sheet3").Select
xlApp.ActiveWindow.SelectedSheets.Delete
'Set Headings
xlApp.Sheets("ACL").Select
xlApp.Cells(Row,6) = "Create"
xlApp.Cells(Row,7) = "Create"
xlApp.Cells(Row,8) = "Create"
xlApp.Cells(Row,9) = "Create"
xlApp.Cells(Row,10) = "Read"
xlApp.Cells(Row,11) = "Write"
row = row + 1
xlApp.Cells(Row,2) = "User"
xlApp.Cells(Row,4) = "Create"
xlApp.Cells(Row,5) = "Delete"
xlApp.Cells(Row,6) = "Personal"
xlApp.Cells(Row,7) = "Personal"
xlApp.Cells(Row,8) = "Shared"
xlApp.Cells(Row,9) = "LotusScript"
xlApp.Cells(Row,10) = "Public"
xlApp.Cells(Row,11) = "Public"
row = row + 1
xlApp.Cells(Row,1) = "Name"
xlApp.Cells(Row,2) = "Type"
xlApp.Cells(Row,3) = "Access"
xlApp.Cells(Row,4) = "Documents"
xlApp.Cells(Row,5) = "Documents"
xlApp.Cells(Row,6) = "Agents"
xlApp.Cells(Row,7) = "Folders/Views"
xlApp.Cells(Row,8) = "Folders/Views"
xlApp.Cells(Row,9) = "Agents"
xlApp.Cells(Row,10) = "Documents"
xlApp.Cells(Row,11) = "Documents"
' Now do the roles
xlApp.Sheets("Roles").Select
row=1
xlApp.Cells(Row,2) = "User"
row = row + 1
xlApp.Cells(Row,1) = "Name"
xlApp.Cells(Row,2) = "Type"
xlApp.Cells(Row,3) = "Access"
col =3
x=1
Forall r In acl.Roles
col=col+1
xlApp.Cells(Row,col) = r
RoleList(r) = x
x=x+1
End Forall
row = 4
'populate the spreadsheet
Set entry = acl.GetFirstEntry
While Not(entry Is Nothing)
xlApp.Sheets("ACL").Select
xlApp.Cells(Row,1) = entry.Name
xlApp.Cells(Row,2) = UserTypeList(entry.UserType)
xlApp.Cells(Row,3) = AccessLevel(entry.Level)
If entry.CanCreateDocuments Then xlApp.Cells(Row,4) = "X"
If entry.CanDeleteDocuments Then xlApp.Cells(Row,5) = "X"
If entry.CanCreatePersonalAgent Then xlApp.Cells(Row,6) = "X"
If entry.CanCreatePersonalFolder Then xlApp.Cells(Row,7) = "X"
If entry.CanCreateSharedFolder Then xlApp.Cells(Row,8) = "X"
If entry.CanCreateLSOrJavaAgent Then xlApp.Cells(Row,9) = "X"
If entry.IsPublicReader Then xlApp.Cells(Row,10) = "X"
If entry.IsPublicWriter Then xlApp.Cells(Row,11) = "X"
xlApp.Sheets("Roles").Select
xlApp.Cells(Row,1) = entry.Name
xlApp.Cells(Row,2) = UserTypeList(entry.UserType)
xlApp.Cells(Row,3) = AccessLevel(entry.Level)
Forall r In entry.Roles
If Not(r = "") Then
col=3+Cint(RoleList(r))
xlApp.Cells(Row,col) = "X"
End If
End Forall
row = row+1
Set entry = acl.GetNextEntry(entry)
Wend
' Bold Titles
xlApp.Sheets("ACL").Select
For y = 1 To 3
For z = 1 To 11
Call GetColumnCode(Cstr(z))
xlApp.Range(sColumnCode & Cstr(y)).Select
With xlApp.Selection.Font
.FontStyle = "Bold"
End With
Next
Next
xlApp.Sheets("Roles").Select
For y = 1 To 2
For z = 1 To x+2
Call GetColumnCode(Cstr(z))
xlApp.Range(sColumnCode & Cstr(y)).Select
With xlApp.Selection.Font
.FontStyle = "Bold"
End With
Next
Next
' autofit the columns in both sheets and underline the titles
xlApp.Sheets("ACL").Select
xlApp.Columns("A:K").EntireColumn.AutoFit
xlApp.Range("A4:K4").Select
With xlApp.Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
xlApp.Sheets("Roles").Select
Call GetColumnCode(Cstr(x+2))
xlApp.Columns("A:" & sColumnCode).EntireColumn.AutoFit
xlApp.Range("A3:" & sColumnCode & "3").Select
With xlApp.Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
End Sub
'=================================
Sub GetColumnCode(sColumnNumber As String)
Select Case sColumnNumber
Case "1"
sColumnCode = "A"
Case "2"
sColumnCode = "B"
Case "3"
sColumnCode = "C"
Case "4"
sColumnCode = "D"
Case "5"
sColumnCode = "E"
Case "6"
sColumnCode = "F"
Case "7"
sColumnCode = "G"
Case "8"
sColumnCode = "H"
Case "9"
sColumnCode = "I"
Case "10"
sColumnCode = "J"
Case "11"
sColumnCode = "K"
Case "12"
sColumnCode = "L"
Case "13"
sColumnCode = "M"
Case "14"
sColumnCode = "N"
Case "15"
sColumnCode = "O"
Case "16"
sColumnCode = "P"
Case "17"
sColumnCode = "Q"
Case "18"
sColumnCode = "R"
Case "19"
sColumnCode = "S"
Case "20"
sColumnCode = "T"
Case "21"
sColumnCode = "U"
Case "22"
sColumnCode = "V"
Case "23"
sColumnCode = "W"
Case "24"
sColumnCode = "X"
Case "25"
sColumnCode = "Y"
Case "26"
sColumnCode = "Z"
Case "27"
sColumnCode = "AA"
Case "28"
sColumnCode = "AB"
Case "29"
sColumnCode = "AC"
Case "30"
sColumnCode = "AD"
Case "31"
sColumnCode = "AE"
Case "32"
sColumnCode = "AF"
Case "33"
sColumnCode = "AG"
Case "34"
sColumnCode = "AH"
Case "35"
sColumnCode = "AI"
Case "36"
sColumnCode = "AJ"
Case "37"
sColumnCode = "AK"
Case "38"
sColumnCode = "AL"
Case "39"
sColumnCode = "AM"
Case "40"
sColumnCode = "AN"
Case "41"
sColumnCode = "AO"
Case "42"
sColumnCode = "AP"
Case "43"
sColumnCode = "AQ"
Case "44"
sColumnCode = "AR"
Case "45"
sColumnCode = "AS"
Case "46"
sColumnCode = "AT"
Case "47"
sColumnCode = "AU"
Case "48"
sColumnCode = "AV"
Case "49"
sColumnCode = "AW"
Case "50"
sColumnCode = "AX"
Case "51"
sColumnCode = "AY"
Case "52"
sColumnCode = "AZ"
End Select
End Sub
