title image


Smiley Da hast Du aber Glück...
...habe vor einiger Zeit etwas derartiges geschrieben.



Step1: Baue folgenden Code in einen Agenten 'ACL anpassen' und passe den Servernamen an. Auswahl in Agentenliste, Ziel: Alle ausgewählten Dokumente.





Sub Initialize

'Setzt den Zugriff auf

'die Benutzermaildatenbank

'für die jeweiligen User auf Entwickler



On Error Resume Next



Dim ws As New NotesUIWorkspace

Dim sess As New NotesSession

Dim db As notesdatabase

Dim dbmail As NotesDatabase

Dim dbnames As NotesDatabase

Dim viewnames As notesview

Dim dbmailacl As NotesACL

Dim entry As NotesACLEntry

Dim dc As NotesDocumentCollection

Dim doc As notesdocument

Dim docnames As NotesDocument

Dim mail As NotesDocument

Dim rtBody As NotesRichTextItem

Dim aw As Variant



Dim strVName As String

Dim strNName As String

Dim strName As String



Set db = sess.CurrentDatabase

Set dbnames = sess.GetDatabase("SERVER/UNTERNEHMEN/DE" , "names.nsf")

Set viewnames = dbnames.GetView("People")

Set dc = db.UnprocessedDocuments

Set doc = dc.GetFirstDocument

Set mail = New NotesDocument(db)

mail.Form = "Memo"

mail.subject = "ACL-Anpassung"

mail.Principal = db.Title

Set rtBody = New NotesRichTextItem (mail , "Body")



Do Until doc Is Nothing

Print doc.Title(0)

Set dbmail = sess.GetDatabase(doc.Server(0), doc.PathName(0))

Call rtBody.AppendText(doc.title(0) & " (" & doc.PathName(0) & ") auf " & doc.Server(0))

Call rtBody.AddNewline(1)

If Not dbmail Is Nothing Then

strVName = Strleft(dbmail.Title, " ")

strNName = Strright(dbmail.Title, " ")

strName = strNName & " , " & strVName

Set docnames = viewNames.GetDocumentByKey (strName)

If docnames Is Nothing Then

Call rtBody.AppendText("Fehler. Dokument für " & strName & " konnte nicht in der names.nsf gefunden werden!")

Call rtBody.AddNewline(1)

Else

Set dbmailACL = dbmail.ACL

Set entry = dbmailACL.GetEntry(docnames.FullName(0))

If entry Is Nothing Then

Call rtBody.AppendText("Fehler. ACL-Eintrag für " & strName & " konnte nicht in der ACL der Datenbank " & dbmail.Title & " gefunden werden!")

Call rtBody.AddNewline(1)

Else

If entry.Level ACLLEVEL_DESIGNER Then

entry.Level = ACLLEVEL_DESIGNER

entry.CanDeleteDocuments = True

entry.CanCreateLSOrJavaAgent = True

Call dbmailACL.Save

Call rtBody.AppendText("Zugriff für Maildatenbank von " & strName & " wurde neu festgelegt!")

Call rtBody.AddNewline(1)

Else

Call rtBody.AppendText("Zugriff für Maildatenbank von " & strName & " ist bereits auf Designer festgelegt!")

Call rtBody.AddNewline(1)

End If

End If

End If

Else

Call rtBody.AppendText ("Fehler. DB " & doc.Pathname(0) & " konnte nicht gefunden werden!")

Call rtBody.AddNewLine(1)

End If

Call rtBody.AddNewLine(1)

Set doc = dc.GetNextDocument (doc)

Loop

Call mail.Send(False, sess.UserName)

End Sub





Step2: In einer Ansicht Deiner Wahl innerhalb des Katalogs baust Du einen Button mit folgendem Code:



@Command([ToolsRunMacro];"(ACL anpassen)")



In Deiner Ansicht markierst Du die Mail-Datenbanken, für die Du den Eintrag vornehmen willst und läßt den Agenten laufen.





Hat bei mir gut geklappt.



HTH



M@rkus

Weil die Lichtgeschwindigkeit höher als die Schallgeschwindigkeit ist, hält man viele Leute für helle Köpfe bis man sie reden hört.


Gruppenfoto 2006: K13



geschrieben von

Login

E-Mail:
  

Passwort:
  

Beitrag anfügen

Symbol:
 
 
 
 
 
 
 
 
 
 
 
 
 

Überschrift: