Das Notes Forum
Domino 9 und frühere Versionen => Entwicklung => Thema gestartet von: Christopher am 03.07.02 - 21:55:44
-
Hallo Leute,
ich will mehrere Dokumente auswählen anschließen will ich ein neues Memo erzeugen. Als erstes wird ein neues Memo erzeugt und anschließend gewisse Informationen in das neue Memo übergeben das funktioniert auch soweit außer mit Dateianhängen. Das Feld wo die Datei angehängt ist heiß "Bemerkungen" und ist ein RichTextFeld mit allen anderen Feldern funktioniert das.
Sub Initialize
Dim workspace As NotesUIWorkspace
Dim uidoc As NotesUIDocument
Dim bodytext As Variant
Set session = New notessession
Set db=session.currentdatabase
Set workspace = New NotesUIWorkspace
Dim i As Integer
Set collection=db.UnprocessedDocuments
Set uidoc=workspace.ComposeDocument("","","MEMO")
bodytext=bodytext+"Sehr geehrte Damen und Herren,"+Chr(10)
bodytext=bodytext+""+Chr(10)
bodytext=bodytext+"bla bla bla"."+Chr(10)
bodytext=bodytext+""+Chr(10)
For i=1 To collection.count
Set doc=collection.GetNthDocument (i)
bodytext=bodytext + doc.FirstName(0) +", " + doc.LastName(0) + ", "+ doc.Location(0)+ ", " + doc.ShowMailServer(0)
' bodytext=bodytext + doc.Bemerkungen(0) +Chr(10)
uidoc.fieldsettext"body",bodytext
uidoc.GotoField("body")
Next
uidoc.fieldsettext"Subject","Hiermit erhalten Sie die geforderte(n) ID-Datei(en)"
uidoc.fieldsettext"SendTo",doc.From(0)
End Sub
-
Hi,
die Anhänge in einem RTF-Feld siehst du erst nach einem erneuten Öffnen des Dokuments.
Ich hab das in einem Fall (hier hat sich s um Doc-Links in einer Task gehandelt) mal so gelöst:
...
Set taskdoc = New NotesDocument(maildb)
taskdoc.Form = "Task"
Call taskdoc.ComputeWithForm(True, True)
'Füllen der entsprechenden Felder
'Einfügen des Doclinks
Call rtitem.AppendText("Vorgang -> ")
Call rtitem.AppendDocLink(doc, "")
Call taskdoc.Save(True,False) 'Temp. Speichern des Backend-Doc. damit RTF-Feld angezeigt wird.
Set taskuidoc = workspace.EditDocument(True, taskdoc) 'Dokument im Frontend öffnen
Call taskdoc.Remove(True) 'Das Dokument, das im Backend erstellt wurde, löschen
...
Ich hoffe das hilft dir weiter.
Axel
-
Hallo Axel,
danke für Deine Hilfe werde es gleich mal nachher ausprobieren.
Gruß Christopher
-
Hallo Axel,
könntest Du mir mal das ganze Script posten?
Danke
Christopher
-
Hi,
hier ist das gesamte Script des Agenten. Dieser wird durch einen Aktionbutton im Dokument aufgerufen.
Sub Initialize
Dim session As New NotesSession
Dim workspace As New NotesUIWorkspace
Dim maildb As NotesDatabase
Dim adressdb As NotesDatabase
Dim currentdb As NotesDatabase
Dim uidoc As NotesUIDocument
Dim doc As NotesDocument
Dim adrdoc As NotesDocument
Dim taskdoc As NotesDocument
Dim taskuidoc As NotesUIDocument
Dim rtitem As NotesRichTextItem
Dim strTemp As String
Dim vDbName As Variant
Dim iAdressDbError As Integer
iAdressDbError = 0
Set currentdb = session.CurrentDatabase
Set uidoc = workspace.CurrentDocument
Set doc = uidoc.Document
'Prüfen ob Mail-DB vorhanden
Set maildb = New NotesDatabase("","")
Call maildb.OpenMail
If Not maildb.IsOpen Then
Messagebox "Mail-Datenbank kann nicht geöffnet werden." + Chr$(10) + "Es wird keine Aufgabe erstellt.", 16, "Adressen"
Exit Sub
End If 'If Not maildb.IsOpen Then
If ConfigLookup("xAdressDB", vDbName) And vDbName(0) = "" Then
iAdressDbError = 1
Else
Set adressdb = New NotesDatabase(currentdb.Server, vDbName(0))
If Not adressdb.IsOpen Then
iAdressDbError = 1
End If 'If Not adressdb.IsOpen Then
End If 'If ConfigLookup("xAdressDB", vDbName) Then
Set adrdoc = adressdb.GetDocumentByUNID(doc.xAdressID(0))
If adrdoc Is Nothing Then
iAdressDbError = 1
End If 'If adrdoc Is Nothing Then
'Neue Aufgabe erstellen
Set taskdoc = New NotesDocument(maildb)
taskdoc.Form = "Task"
Call taskdoc.ComputeWithForm(True, True)
If doc.Kontaktperson(0) = "" Then
strTemp = doc.Firma(0)
Else
strTemp = doc.Kontaktperson(0) + " - " + doc.Firma(0)
End If 'If doc.Kontaktperson(0) = "" Then
taskdoc.Subject = "Aufgabe zu einem Vorgang zu " + strTemp
'Anlegen und füllen des Richtextfeldes
Set rtitem = taskdoc.CreateRichTextItem("Body" )
Call rtitem.AppendText(doc.Aktionen(0))
Call rtitem.AddNewLine(2)
Call rtitem.AppendText("Vorgang -> ")
Call rtitem.AppendDocLink(doc, "")
If Not iAdressDbError Then
Call rtitem.AddNewLine(2)
Call rtitem.AppendText("Adresse -> ")
Call rtitem.AppendDocLink(adrdoc, "")
End If 'If Not iAdressDbError Then
Call taskdoc.Save(True,False) 'Temp. Speichern des Backend-Doc. damit RTF-Feld angezeigt wird.
Set taskuidoc = workspace.EditDocument(True, taskdoc) 'Dokument im Frontend öffnen
Call taskdoc.Remove(True) 'Das Dokument, das im Backend erstellt wurde, löschen
End Sub
Der Vollständigkeit wegen hier noch die Funktion ConfigLookup.
Function ConfigLookup(sField As String, vFieldValue As Variant) As Integer
Const sView = "vwKonfigurationLookup"
Const sKey = "Allgemein"
Dim session As New NotesSession
Dim db As NotesDatabase
Dim view As NotesView
Dim doc As NotesDocument
On Error Goto ConfigLookup_Error
Set db = session.CurrentDatabase
Set view = db.GetView(sView)
Set doc = view.GetdocumentByKey(sKey)
vFieldValue = doc.GetItemValue(sField)
ConfigLookup = 0
Exit Function
ConfigLookup_Error:
ConfigLookup = 1
Resume Next
End Function
Axel
-
Hallo Axel,
danke für Deine Script.
Viele Grüß
Christopher