Hier eine Version der automatischen Mailweiterleitung einer Firma, die dieses - für mich nicht sonderlich vertrauensförderliche - Gehabe auch macht:
Erstelle einen Agenten in der Mailschablone, setze den Userzugriff nur noch auf Designerrechte - dann hast du das, was hier gemacht wird.
Anmerkung zum Agenten: Ich habe die firmenspezifischen Dinge rausgenommen. und umbenannt. Ob's jetzt noch funzt, weiss ich nicht. Probiert's mal.
Bitte keine Kommentare zum Stil... ich war's nicht und würde es anders machen - oder besser gesagt: GAR NICHT!
Gruss
Bodo
Hintergrundagent, periodisch mehrmals am tag
gilt für alle neuen und geänderten dokumente in der db
Sub Initialize
%REM
Dieser Agent läuft periodisch in den Mail-Datenbanken der Mitarbeiter.
Er läuft unter dem Namen des Mail-Eigentümers und wird ggf. beim Öffnen der Datenbank aktiviert (Db-Script.PostOpen).
Ablauf-Beschreibung:
- beim ersten Start - keinerlei Aktion
- alle seit dem letzten Start hinzugekommenen Dokumente (unprocessed) mit der Form "Memo" und "Reply" werden behandelt
- Weiterleitungs-Konfiguration für den Datenbank-Eigentümer wird aus der Mitarbeiter-Datei gelesen
- eingehende Mail wird ggf. an einen Weiterleitungs-Adressaten gesendet (SendTo)
- ein- und ausgehende Mail externe Mail wird ggf. in die "Abteilungs-Mailbox" (mail\abt-mail.nsf) kopiert (Leser-Feld=Abteilung)
%END REM
Dim session As New NotesSession
Dim db As NotesDatabase
Dim collection As NotesDocumentCollection
Dim doc As NotesDocument
Dim agent As NotesAgent
Set db = session.CurrentDatabase
Set collection = db.UnprocessedDocuments ' von diesem Agenten noch nicht gesehene Dokumente
If collection.count = 0 Then Exit Sub
Set agent = session.CurrentAgent
If agent.HasRunSinceModified = False Then Exit Sub
Dim DateTime As New NotesDateTime (agent.LastRun) ' letzter Start dieses Agenten
dbOwner = Left(db.FileName,Instr(db.FileName,".")-1)
dbOwner = Ucase(Mid(dbOwner,1,1))+Lcase(Mid(dbOwner,2,Len(dbOwner)-1)) ' Namenskürzel in Firmen-Schreibweise - wg. Novell...
Dim dbP As New NotesDatabase ("","")
Call dbP.Open (db.Server,"Personal.nsf") ' Mitarbeiter-Datenbank
Set viewP = dbP.GetView("vwIndexID")
Set docP = viewP.GetDocumentByKey(Ucase(dbOwner),True) ' Personen-Dokument des Mitarbeiters
If docP Is Nothing Then
' Fehlermeldung schicken ?
Exit Sub
End If
If Not docP.HasItem("PMailWeiterleitung") Then Exit Sub
Intern = False ' Interne Mail weiterleiten ?
Extern = False ' Externe Mail weiterleiten ?
AbtBox = False ' In Abteilungs-Mailbox weiterleiten ?
Set item = docP.GetFirstItem("PMailTypWeiterleitung")
If docP.PMailWeiterleitung(0)<>"" Then
If item.contains("I") Then Intern=True
If item.contains("E") Then Extern=True
' eingetragene Adressaten für Mail-Weiterleitung bestimmen
Redim An(0) As String
For j=0 To Ubound(docP.PMailWeiterleitung)
Kurz = docP.PMailWeiterleitung(j)
Kurz = Trim(Mid(Kurz,Instr(Kurz,"(")+1,100))
Kurz = Trim(Mid(Kurz,1,Instr(Kurz,")")-1))
Kurz = StringReplace ("ä","ae",Kurz)
Kurz = StringReplace ("ö","oe",Kurz)
Kurz = StringReplace ("ü","ue",Kurz)
Redim Preserve An(j) As String
An(j) = Kurz+"/DOMAENE"
Next
End If
If docP.PMailWeiterleitungAbteilung(0)<>"nein" Then AbtBox=True
If AbtBox = True Then
Dim dbA As New NotesDatabase ("","")
Call dbA.Open (db.Server,"Mail\Abt-Mail.nsf") ' Abteilungs-Mailbox
Dim docA As NotesDocument
End If
For i = 1 To collection.Count ' alle noch nicht gesehenen Dokumente
Set doc = collection.GetNthDocument( i )
' nur Mail-Documente, die nach dem letzten Start des Agenten erzeugt wurden
If (doc.Form(0) = "Memo" Or doc.Form(0) = "Reply") And doc.Created >= DateTime.LSLocalTime Then
If AbtBox=True Then ' in Abteilungs-Mailbox weiterleiten
If Instr(doc.From(0),"@")<>0 Or _
( Instr(doc.SendTo(0),"@")<>0 ) And Instr(doc.SendTo(0),"DOMAENE@MAILDOMAENE")=0 Then ' nur externe Mail
Set docA = dbA.CreateDocument ' neues Dokument in Abteilungs-Mailbox
Call doc.CopyAllItems(docA)
docA.Form = "Memo"
Set rtitem = docA.CreateRichTextItem("DocLink") ' Doc-Link zum Mail-Dokument in Benutzer-Mail-DB
Call rtitem.AppendDocLink (doc,"Mail-Dokument in Mailbox von "+dbOwner)
Set item = New NotesItem (docA,"Leser", "[Manager]") ' Leser-Feld setzen, Sichtbarkeit !
Call item.AppendToTextList ("["+docP.PAbt(0)+"]") ' Rolle = Abteilungsnummer
item.IsReaders = True
docA.Principal = doc.From(0) ' ursprünglicher Absender
docA.INTERNSendTo = doc.SendTo ' sichern des ursprünglichen Adressaten
ToINTERN=False ' Eigehende Mail ?
For j=0 To Ubound(docA.INTERNSendTo)
If Instr(Ucase(docA.INTERNSendTo(j)),"@UnsereDomaene.DE")<>0 Then ToINTERN=True
Next
If ToINTERN Then docA.InternSendTo = dbOwner ' wenn eingehende Mail, ursprünglicher Adressat
docA.InternPostedDate = doc.PostedDate ' ursprüngliches Absendedatum/-zeit
docA.INTERNAbteilung = docP.PAbt(0)
Call docA.Save(True,True)
End If
End If
doc.Subject = "Weiterleitung von "+dbOwner+": "+doc.Subject(0) ' für Weiterleitung an Mitarbeiter
doc.CopyTo = "" ' Keine Kopien weiterleiten
If Instr(doc.From(0),"@")<>0 And Extern=True Then ' Externe weiterleiten
doc.SendTo = An
Call doc.Send(False)
End If
If Instr(doc.From(0),"@")=0 And _
Instr(Ucase(doc.From(0)),"CN="+Ucase(dbOwner)+"/")=0 And _
Intern=True Then ' Interne weiterleiten
doc.SendTo = An
Call doc.Send(False)
End If
End If ' If (doc.Form(0) = "Memo" Or doc.Form(0) = "Reply") And doc.Created >= DateTime.LSLocalTime
Call session.UpdateProcessedDoc(doc) ' Dokument als erledigt markieren
Next
End Sub
Function StringReplace(strAlt As String, strNeu As String, strZeichenString As Variant) As String
If strAlt="" Or strNeu="" Or strZeichenString="" Then
Exit Function
End If
strZ = strZeichenString
Lalt = Len(strAlt)
Do
ipp& = Instr(1, strZ, strAlt)
If ipp&> 0 Then
strZ = Mid(strZ, 1, ipp&-1) +strNeu +Mid(strZ, ipp&+Lalt, Len(strZ)-ipp&-Lalt+1)
End If
Loop Until ipp&= 0
StringReplace=strZ
End Function
