Erst einmal Danke Ullrich für das Teil. Das war genau der Stups in die richtige Richtung.
Und für alle die es interessiert, hier der fertige Code. Der geht allerdings von ein paar Prämissen aus:
1. da wo der Agent läuft sind Adressbücher verfügbar
2. überprüft wird gegen den FullName und den ShortName, nicht gegen den Lastname (wobei das einfach zu ergänzen wäre aber keinen Sinn macht solange Punkt 3 nicht realisiert ist)
3. doppelte Einträge werden noch nicht unterstützt (da muss noch ein wenig Logik rein)
4. bei GROSSEN Addressbüchern könnte das etwas Performance kosten, da alle verfügbaren Adressbücher abgeklappert werden.
Option Public
Option Declare
' dims
Dim formnames List As String
Dim userdclist List As String
Dim alluserslist List As String
Sub Initialize
%REM
This agent Gathers all new and modified documents.
It sends a summary mail to that user that is declared as responsible in the document
%END REM
Dim session As New NotesSession
Dim db As NotesDatabase
Dim view As NotesView
Dim chdoccol As notesdocumentcollection
Dim founddoc As NotesDocument
Set db = session.CurrentDatabase
' fetch all valid users from all addressbooks
Call fetchvalidusers(Session)
' build List of Forms not to be added to the newsletter
Call buildformnameslist
' use unprocessed as document collection
Set chdoccol = db.UnprocessedDocuments
' build a list of the documents that are related to each user
Call builduserdocumentlist(chdoccol)
' send on doucment with all items to each user in the list
Call sendusermail
End Sub
Sub buildformnameslist
' forms not to be watched
Formnames("frmConfigExternalDatabase") = "frmConfigExternalDatabase"
Formnames("frmConfigDatatransfer") = "frmConfigDatatransfer"
Formnames("frmConfigFieldGovernance") = "frmConfigFieldGovernance"
Formnames("frmConfigKeywords") = "frmConfigKeywords"
Formnames("frmConfigKeywordCouples") = "frmConfigKeywordCouples"
Formnames("frmprofileSequentialNumber") = "frmProfileSequentialNumber"
Formnames("frmConfigTeams") = "frmConfigTeams"
Formnames("frmConfigUserAccess") = "frmConfigUserAccess"
Formnames("frmConfigUserConfiguration") = "frmConfigUserConfiguration"
End Sub
Sub builduserdocumentlist(mydc As NotesDocumentCollection)
Dim founddoc As NotesDocument
Dim founditem As notesitem
Dim username As NotesName
Dim strusername As String
Dim i As Integer
Set founddoc = mydc.GetFirstDocument()
Do While Not founddoc Is Nothing
' check if document is not in the unwanted documents list
If Iselement(formnames(founddoc.form(0))) = False Then
If founddoc.HasItem("fldErledigenVerantwortlich") Then
'get all the values of this item if it is a multivalue field
Set founditem = founddoc.GetFirstItem("fldErledigenVerantwortlich")
Forall v In founditem.Values
' check if v is a valid UserName
' search to know if the name exist
If Not(Trim(v)="") Then
strusername = v
' reshape the users name if a matching name is found
If Iselement(alluserslist(strusername)) = True Then
strusername = alluserslist(strusername)
' check if there is already an entry in the userdocumentlist
If Iselement(userdclist(strusername)) = True Then
userdclist(strusername) = userdclist(strusername) + "~" + founddoc.UniversalID
Else
userdclist(strusername) = founddoc.UniversalID
End If
Else
If Iselement(userdclist("User not Found " + strusername)) = True Then
userdclist("User not Found " + strusername) = userdclist("User not Found " + strusername) + "~" + founddoc.UniversalID
Else
userdclist("User not Found " + strusername) = founddoc.UniversalID
End If
End If
End If
End Forall
End If
End If
Set founddoc = mydc.getnextdocument(founddoc)
Loop
End Sub
Sub Sendusermail
' sends the mail to the user. The mail is send as html and as NotesACL mail wich later on will be konfigurable for the type of user (notes or web)
' each document found is one entry in the list
Stop
End Sub
Sub fetchvalidusers(mysession As NotesSession)
Dim mybooks As Variant
Dim myview As NotesView
Dim mydoc As NotesDocument
Dim myitem As NotesItem
Dim myqualifiedname As String
Dim myfoundqualified As Integer
Dim mypersonname As String
Dim i As Integer
mybooks = mysession.AddressBooks
Forall b In mybooks
' check every Domino Directory,
' unless we're already done
If ( b.IsPublicAddressBook ) Then
Call b.Open( "", "" )
' look up person's last name
' in People view of address book
Set myview = b.GetView( "People" )
Set mydoc = myview.Getfirstdocument()
Do While Not mydoc Is Nothing
' fetch the persons fully qualified name and check if it is a full qualified name
If mydoc.HasItem("Fullname") Then
Set myitem = mydoc.GetFirstItem("FullName")
Forall v In myitem.Values
mypersonname = v
If validateuser(mypersonname) = True Then
myqualifiedname = mypersonname
myfoundqualified = True
Exit Forall
End If
End Forall
If myfoundqualified = True Then
' fetch the full name
Call fetchnameandadd(mydoc,"FullName", myQualifiedname)
' fetch the short name entry
Call fetchnameandadd(mydoc,"ShortName", myQualifiedname)
End If
End If
Set mydoc = myview.GetNextDocument(mydoc)
Loop
End If
End Forall
End Sub
Function validateuser(myusername As String) As Integer
Dim checkusername As NotesName
Set checkuserName = New NotesName(myusername)
If (checkuserName.CANONICAL = checkuserName.COMMON) Then
validateuser = False
Else
validateuser = True
End If
End Function
Sub fetchnameandadd(mydoc As NotesDocument, myitemname As String, myqualifiedname As String)
Dim myitem As NotesItem
If mydoc.HasItem(myitemname) Then
Set myitem = mydoc.GetFirstItem(myitemname)
' add all entries in this item to the list
Forall v In myitem.Values
If Iselement(alluserslist(v)) = False Then
alluserslist(v) = myqualifiedname
End If
End Forall
End If
End Sub
Und wenn jemand das bis hierhin gelesen und nicht verstanden hat dann kann ich ihm das gerne noch erklären.
Thema: Prüfen ob der Benutzer im Directory existiert (Gelesen 1203 mal)