Hier der Code der Weiterleitung
Sub Click(Source As Button)
Dim session As New NotesSession
Dim ws As New NotesUIWorkspace
Dim db As Notesdatabase
Dim uidoc As NotesUIDocument
Dim doc As NotesDocument
Dim Profildoc As NotesDocument
Dim rc As Variant
Dim gruppe As String
Dim memberliste As Variant
Dim person As NotesName
On Error Goto catch
Set db = session.CurrentDatabase
Set uidoc=ws.currentDocument
Set doc = uidoc.Document
Set ProfilDoc = db.GetProfileDocument( "(Konfiguration)" )
heute = Today()
profilgruppe = ProfilDoc.CFG_ZuweisenGruppe(0)
If doc.document_status(0) = "erledigt" Then
Msgbox "Sie können keine bereits erledigten Dokumente zuweisen.",,db.Title
Exit Sub
End If
If profilgruppe = "" Then
'Gruppe anhand des PK Names auflösen
postkorbtitel = db.Title
gruppe = Mid$(postkorbtitel, 3,99)
Else
'Gruppe aus Profil verwenden
gruppe = profilgruppe
End If
'ist die gruppe auch vorhanden ?
Dim nab As New NotesDatabase("","names.nsf")
Dim grpView As NotesView
Dim gruppendoc As NotesDocument
Set nab = New NotesDatabase(db.server,"names.nsf")
Set grpView = nab.GetView("Groups")
Set gruppendoc = grpView.GetDocumentByKey(gruppe)
If Not gruppendoc Is Nothing Then
'Gruppen auflösen
memberliste = getPersonMembers(gruppe)
SortiertesArray = QuickSort(memberliste) 'sortieren
SortiertesArray = Arrayappend( SortiertesArray, "andere Person- (Datenbank-Zugriff beachten !)" )
SortiertesArray = unique(SortiertesArray) 'doppelte werte löschen
rc =ws.prompt(PROMPT_OKCANCELLIST,"Personenauswahl","Bitte wählen Sie eine Person aus!",SortiertesArray(0),Fulltrim(SortiertesArray))
If ( Isempty( rc ) ) Then
Exit Sub
Elseif rc = "andere Person- (Datenbank-Zugriff beachten !)" Then
rc = ws.PickListStrings(PICKLIST_NAMES, False)
If ( Isempty( rc ) ) Then
Exit Sub
Else
Set person = session.CreateName(rc(0))
End If
Else
Set person = session.CreateName(rc)
End If
Else
rc = ws.PickListStrings(PICKLIST_NAMES, False)
If ( Isempty( rc ) ) Then
Exit Sub
Else
Set person = session.CreateName(rc(0))
End If
End If
'Dokument anpassen
doc.document_status = "zugewiesen"
doc.document_send = person.Common
doc.document_bearbeiter = person.Common
doc.document_historie = doc.GetItemValue("document_historie")(0) & Chr$(10) & heute &_
": " & session.CommonUserName &" wies das Dokument: " & person.Common &" zu"
Call doc.Save( False, True )
'Mail senden
Dim mdoc As NotesDocument
Set mdoc = New NotesDocument(db)
mdoc.Form = "Memo"
mdoc.Subject = "Ihnen wurde eine Mail zugewiesen!"
Set rtItem= New NotesRichTextItem( mdoc , "Body")
Call rtitem.AppendText("Ihnen wurde eine Mail zugewiesen!")
Call rtitem.AddNewline (2)
Call rtitem.AppendText("Sie erreichen die Mail über folgendes Symbol:")
Call rtitem.AddNewline (2)
Call rtitem.AppendDocLink(doc, "")
Call mdoc.Send (False, person.Canonical)
Call uidoc.Close
finally:
Exit Sub
catch:
On Error Resume Next
errorcode$=Cstr(Err)
If errorcode$<>"4412" Then ' Fehler in der Feldvalidierung nicht extra ausgeben
errline= "Fehler: "+ErrorCode$+" " +Error +" in Zeile: " +Cstr(Erl)
Msgbox(errline)
' Call nlog.logerror(0,errline)
End If
Resume finally
End Sub
