Hi Ata,
sorry, hätte doch den ganzen Code posten sollen, hier ist er:
Sub Click(Source As Button)
Dim session As New NotesSession
Dim ws As New NotesUIWorkspace
Dim uidoc As NotesUIDocument
Dim dbMail As NotesDatabase
Dim docMail As NotesDocument
Dim uidocMail As NotesUIDocument
Dim profil As NotesDocument
Dim docThis As NotesDocument
Dim rti As NotesRichTextItem
Set uidoc = ws.CurrentDocument 'ui
Set docThis = uidoc.Document 'ui
'Prüfen ob Mail-DB vorhanden
Set dbMail = New NotesDatabase("","")
Call dbMail.OpenMail
If Not dbMail.IsOpen Then
Messagebox "Mail-Datenbank kann nicht geöffnet werden." + Chr$(10) + "Es wird kein Mail erstellt.", 16, "Fehler"
Exit Sub
End If 'If Not dbMail.IsOpen Then
'Mail erstellen
CreateMailMemo = 0
Set profil = dbMail.GetProfileDocument("CalendarProfile")
Set docMail = New NotesDocument(dbMail) 'neues Mail
docMail.Form = "Memo" 'nimm Memo
docMail.Logo = profil.DefaultLogo(0) 'Dient dazu, das Mail-Logo zu übernehmen
docMail.Principal = profil.Owner(0) 'Dient dazu, das Mail-Logo zu übernehmen
'Mail-Felder füllen
docMail.SendTo = docThis.a_test2 'Mailempfänger
docMail.Subject = "Link: #" + docThis.a_ID(0) + " ( " + docThis.a_Area(0) + ")" 'Subject
'Anlegen und füllen des Richtextfeldes
Set rti = docMail.CreateRichTextItem("Body" )
Call rti.AddNewLine(3)
Call rti.AppendText("Doc-Link >")
Call rti.AppendDocLink(docThis, "") 'Doklink einfügen
Call rti.AppendText("<")
Call rti.AddNewLine(1)
'Temp-Speichern Backend-Doc, Öffnen Frontend-Doc, zum Schluß Löschen Backend-Doc (damit RTF-Feld angezeigt wird)
Call docMail.Save(True,False)
Set uidocMail = ws.EditDocument(True, docMail)
Call docMail.Remove(True)
'Gehe zum Feld Body
Call uidocMail.GotoField("Body")
End Sub
Body ist also eigentlich doch dann vorhanden....
TMC
OK, habe mal die letzten Zeilen wie folgt angepasst:
'Temp-Speichern Backend-Doc, Öffnen Frontend-Doc, zum Schluß Löschen Backend-Doc (damit RTF-Feld angezeigt wird)
Call docMail.Save(True,False) 'Backend speichern
Set uidocMail = ws.EditDocument(True, docMail) 'uidocMail öffnen
Call uidocMail.Close 'uidocMail schließen
Set uidocMail = ws.EditDocument(True, docMail) 'uidocMail öffnen
Call docMail.Remove(True) 'Backend löschen
'Gehe zum Feld Body
Call uidocMail.GotoField("Body")
End Sub
Klappt allerdings noch immer nicht.....
TMC