Hallo,
ich habe mal wieder ein Notes-Problem. Ich habe eine Script, was nach dem Starten den Homemailserver des Benutzers aus dem names.nsf ziehen soll und dann diesen in der Arbeitsumgebung setzten muss.
Dies soll nicht per Click auf eine Schaltfläche passieren, sondern mit PostOpen Event, aber nur einmal für die aktuelle Notes-Session:
Dies ist das Script, was per Clickt funktioniert:
Declarations
Const cMailServer="IhrMailserver"
Const cMailDomain="IhreNotesDomäne"
Const cCatalogServer=""
Const cDirectoryServer=""
Const cNameView="Locations"
Const cSubject="Arbeitsumgebungen aktualisiert"
Const cAdminMail="IhrName@IhreDomain.de"
Dim ses As NotesSession
Dim pad As NotesDatabase
Dim db As notesdatabase
Dim ploc As NotesView
Dim pdoc As NotesDocument
Dim mdoc As NotesDocument
Dim rtf As NotesRichTextItem
Dim nrloc As Integer
Dim ddb As NotesDatabase
Dim persDoc As NotesDocument
Dim persView As NotesView
Dim mailfile As String
Click
Sub Click(Source As Button)
Set ses = New NotesSession
Set db = ses.currentdatabase
Set pad = ses.getdatabase("","names.nsf")
If pad Is Nothing Then
Msgbox "Kann lokales Adressbuch nicht finden."
Exit Sub
End If
Set ddb = ses.getDatabase(cMailServer,"names.nsf")
If ddb Is Nothing Then
Msgbox "Kann Adressbuch von Server "+cMailServer+" nicht finden"
Exit Sub
End If
If Not ddb.isopen Then
Msgbox "Kann Adressbuch von Server "+cMailServer+" nicht öffnen"
Exit Sub
End If
Set persView = ddb.getView("($Users)")
If persView Is Nothing Then
Msgbox "Kann View ($Users) im Verzeichnis auf Server "+cMailServer+" nicht finden"
Exit Sub
End If
Set persDoc = persView.Getdocumentbykey(ses.Effectiveusername, True)
If persDoc Is Nothing Then
Msgbox "Kann Personendokument für "+ses.Effectiveusername+" nicht finden"
Exit Sub
End If
mailfile = persdoc.mailfile(0)
Set ploc = pad.getView(cNameView)
If ploc Is Nothing Then
Msgbox "Kann Ansicht "+cNameView +" in lokalem Adressbuch nicht finden."
Exit Sub
End If
nrloc = 0
Set mdoc = db.createDocument
Set rtf = mdoc.createRichTextItem("Body")
Set pdoc = ploc.getFirstDocument
While Not pdoc Is Nothing
Print pdoc.name(0)
pdoc.MailServer = cMailServer
pdoc.Domain = cMailDomain
pdoc.CatalogServer = cCatalogServer
pdoc.DirectoryServer = cDirectoryServer
pdoc.MailFile = mailfile
'eventuell ein recalc
'Call pdoc.Computewithform(true,false)
Call pdoc.save(True,False)
Call rtf.appendText(pdoc.Name(0))
Call rtf.addnewLine(1)
nrloc = nrloc + 1
Set pdoc = ploc.Getnextdocument(pdoc)
Wend
Call rtf.appendText("Mailfile: "+mailfile)
Call rtf.addnewLine(1)
mdoc.Subject = cSubject+" "+ses.Commonusername+" ("+Cstr(nrloc)+")"
mdoc.SendTo = cAdminMail
mdoc.form = "Memo"
Call mdoc.send(False)
Msgbox Cstr(nrloc) +" Arbeitsumgebungen wurden geändert und die Administration per Mail benachrichtigt."
End Sub
Ich habe Click, Sub und Endsub weggeschnitten und in das PostOpen oberhalb von EndSub kopiert. Aber leider sagt er an unserschiedlichen Stellen, es wäre ein Fehler drin.
Gruss,
Micha