Ich habe ein Script, mit dem man aus einer Vorlagendatenbank (das muss nicht die Mail sein ! ) ein neues Memo erstellen kann. Es ist ganz nützlich, wenn mit unternehmensweiten Vorlagen gearbeitet werden soll.
'Beginn Anpassungen Mail-Schablone
Dim vorlagenServer As String
Dim vorlagenPath As String
vorlagenServer = "<Server>" 'ANPASSEN !!!!
vorlagenPath = "glombi\vorlagen.nsf" 'ANPASSEN !!!!
Dim selectedvorlagedoc As NotesDocument
'Ende Anpassungen Mail-Schablone
Dim session As New notessession
Dim uiws As New notesuiworkspace
Dim collection As notesdocumentcollection
Dim noteUIEditDocument As notesuidocument
Dim database As NotesDatabase
Set noteCursorDoc = session.currentdatabase.createdocument
Set database = session.currentdatabase
'Beginn Anpassungen Mail-Schablone
' hier die Originalzeile
'Set collection = uiws.Picklistcollection(PICKLIST_CUSTOM, False, database.server, database.filepath, "Stationery", "Vorlage wählen", "Wählen Sie bitte eine Vorlage für das neue Memo.")
'hier die angepasste Zeile - Auswahl aus Vorlagen-Datenbank
Set collection = uiws.Picklistcollection(PICKLIST_CUSTOM, False, vorlagenServer, vorlagenPath, "Stationery", "Vorlage wählen", "Wählen Sie bitte eine Vorlage für das neue Memo.")
%REM
'Originalcode
If Not(collection Is Nothing) Then '//User may have cancelled
Set noteCursorDoc = collection.getfirstdocument
If Not noteCursorDoc Is Nothing Then
Set noteUIEditDocument = uiws.Editdocument(False, noteCursorDoc)
End If
End If
%END REM
'die Vorlage muss in die Mail-Datenbank des Anwenders kopiert werden
If Not(collection Is Nothing) Then '//User may have cancelled
Set selectedvorlagedoc = collection.getfirstdocument
If selectedvorlagedoc Is Nothing Then Exit Sub
Set noteCursorDoc = selectedvorlagedoc.CopyToDatabase( database )
If Not noteCursorDoc Is Nothing Then
'Setze User-spezifische Felder
noteCursorDoc.Principal = session.UserName
noteCursorDoc.From = session.UserName
Set noteUIEditDocument = uiws.Editdocument(False, noteCursorDoc)
'Die kopierte Vorlage muss gelöscht werden, ansonsten bleibt diese in der Mail-Datenbank bestehen
On Error Resume Next 'falls Löschen fehl schlägt einfach weiter
Call noteCursorDoc.Remove( True )
End If
End If
'Ende Anpassungen Mail-Schablone
Exit Sub
Andreas