[LotusScript] 刷新一般人員的ACL權限-CSDN博客

本文介绍了一个批量更新Notes数据库ACL权限的脚本，并在更新过程中检查账户是否存在，确保账户名称的正确性和唯一性。通过脚本实现自动化处理，提高效率并减少错误。

摘要生成于 C知道，由 DeepSeek-R1 满血版支持，前往体验 >

1 (Initialize)
Sub Initialize
On Error Goto ErrHandler
Dim sView As NotesView
Dim sDoc As NotesDocument
Set s = New NotesSession
Set db = s.CurrentDatabase
Dim isExist As String
'Dim Level As Integer

Set EmpDB=s.getdatabase(db.Server,"SYSTEM\\UGOP.nsf")
Set EmpOldView= EmpDB.GetView("(ByOldEName)")

Set ApList = db.getView("Vw_ApList")
Set Ap = ApList.GetFirstDocument
While Not(Ap Is Nothing)
  Set refreshDB = s.GetDatabase(Ap.ServerIp(0),Ap.ApPath(0))
  Print "資料庫路徑:-----------" +Ap.ServerName(0)+":::::"+Ap.ApPath(0)
  Call refreshDB.sign(DBSIGN_DOC_ALL)
  Set acl = refreshDB.ACL

  If refreshDB.QueryAccess(s.UserName) <> 6 Then
   Msgbox "您不是系統管理員，無權執行此程式!!!!"
   'Call SendToMail(Ap.ServerName(0)&"您不是系統管理員，無權執行此程式!!!!")
   'Exit Sub
   Ap.aflag = "N"
   Call Ap.Save(True,True)
   Goto ErrHandler
  End If

  Set entry = acl.GetFirstEntry
  While Not(entry Is Nothing)
   '只更新 Person
   If entry.IsPerson And Not(entry.IsGroup) Then
    Set EmpODoc = EmpOldView.getdocumentbykey(UserNames("[ABBREVIATE]",entry.Name),True)
    If Not( EmpODoc Is Nothing) Then
     '檢查帳號是否存在
     If Ucase(entry.Name) <> Ucase(EmpODoc.NotesFullName(0)) Then
      Print "Old Name:______________"+entry.Name
      Print "New Name:______________"+EmpODoc.NotesFullName(0)
      isExist = "N"
      Set aclcheck = refreshDB.ACL
      Set check = aclcheck.GetFirstEntry
      '檢查欲新增的帳號是否已存在
      While Not check Is Nothing
       If Ucase(check.Name) = Ucase(EmpODoc.NotesFullName(0)) Then
        isExist = "Y"
       End If
       Set check = aclcheck.GetNextEntry(check)
      Wend

      If isExist <>"Y" Then
           '在ACL中添加新条目:
       Set acl = refreshDB.ACL
       '这个例子中，我们添加管理员 With Wang/CN/CMINL
       Set nEntry = acl.CreateACLEntry(EmpODoc.NotesFullName(0), entry.Level )
       stringArray = entry.Roles
       nEntry.CanCreateDocuments = entry.CanCreateDocuments
       nEntry.CanCreateLSOrJavaAgent = entry.CanCreateLSOrJavaAgent
       nEntry.CanCreatePersonalAgent = entry.CanCreatePersonalAgent
       nEntry.CanCreatePersonalFolder = entry.CanCreatePersonalFolder
       nEntry.CanCreateSharedFolder = entry.CanCreateSharedFolder
       nEntry.CanDeleteDocuments = entry.CanDeleteDocuments
       nEntry.CanReplicateOrCopyDocuments = entry.CanReplicateOrCopyDocuments
       nEntry.IsAdminReaderAuthor = entry.IsAdminReaderAuthor
       nEntry.IsAdminServer = entry.IsAdminServer
       nEntry.IsGroup = entry.IsGroup
       nEntry.IsPerson = entry.IsPerson
       nEntry.IsPublicReader = entry.IsPublicReader
       nEntry.IsPublicWriter = entry.IsPublicWriter

       If entry.Roles(0) <>"" Then
        For i=0 To Ubound(stringArray)
         Call nEntry.EnableRole(stringArray(i))
        Next
       End If

      End If
     End If
    End If
   End If
   Set entry = acl.GetNextEntry(entry)
  Wend
'保存对ACL的更改
  Call acl.Save
  Ap.aflag = "Y"
  Call Ap.Save(True,True)
  Goto ErrHandler
ErrHandler:
  Set Ap = ApList.GetNextDocument(Ap)
Wend
'Call SendMail("OK")
'Msgbox("OK")
Print "OK"
'Call SendToMail("OK")
End Sub

2 Function UserNames
Function UserNames (Action As String, Username As Variant) As String
Dim InputName As New NotesNAME(Username)
Action=Ucase(Action)
Select Case Action
Case "[CANONICAL]"
  UserNames=InputName.Canonical
Case "[ABBREVIATE]"
  UserNames=InputName.Abbreviated
Case "[CN]"
  UserNames=InputName.Common
Case "[C]"
  UserNames=InputName.Country
Case "[OU1]"
  UserNames=InputName.OrgUnit1
Case "[OU2]"
  UserNames=InputName.OrgUnit2
Case "[OU3]"
  UserNames=InputName.OrgUnit3
Case "[O]"
  UserNames=InputName.Organization
Case Else
  UserNames=InputName.Canonical
End Select
End Function