Hier der ganze code:
Sub Click(Source As Button)
Dim wk As New notesuiworkspace
Dim session As New NotesSession
Dim db As notesDatabase
Dim db2 As notesDatabase
Dim doc As notesdocument
Dim doc2 As notesdocument
Dim uidoc As notesuidocument
Dim coll As NotesDocumentCollection
Dim view As notesview
Set db2 = session.currentdatabase
'Set sn = New NotesName( db.server )
Dim ndoc As notesdocument
Set uidoc = wk.currentdocument
uidoc.Refresh
uidoc.Reload
Set ndoc = wk.currentdocument.document
uidoc.save 'Hier tritt der Fehler beim versenden mit Anhang auf
ndoc.saveoptions =0
If Not db2.isopen Then
Msgbox "database not found"
Exit Sub
End If
Set view =db2.getview("VMailAdresses")
Dim coll2 As notesdocumentcollection
Dim u As Integer
u=1
Forall x In ndoc.co_empfaenger
If x<>"" Then
If u=1 Then
Set coll = view.getalldocumentsbykey(Cstr(x))
If coll.count>0 Then u=2
Else
Set coll2 = view.getalldocumentsbykey(Cstr(x))
Set doc=coll2.getfirstdocument
While Not doc Is Nothing
If coll Is Nothing Then
End If
If coll.getdocument(doc) Is Nothing Then
Call coll.adddocument(doc)
End If
Set doc = coll2.getnextdocument(doc)
Wend
End If
End If
End Forall
Dim rt As notesrichtextitem
Dim rte As notesrichtextitem
Dim mdoc As notesdocument
%REM
If coll.count>0 Then
Set mdoc = db2.createdocument
Set rt = ndoc.getfirstitem("Body")
Call rt.copyitemtodocument(mdoc,"Body")
mdoc.subject = ndoc.subject
mdoc.in_icon = 140
mdoc.form = "MMass"
mdoc.in_Type =""
mdoc.ComputeWithForm False, False
Call mdoc.save(True,True)
End If
%END REM
Set doc=coll.getfirstdocument
Do Until doc Is Nothing
Set rt = ndoc.getfirstitem("Body")
If Trim$(doc.co_CompanyEmail(0)) <> "" Then
Print "Verarbeite Person ", doc.Fullname(0)
Set doc2 = db2.createdocument
Set rtItem = New NotesRichTextItem(doc2, "Body")
Dim stmp As String
stmp = ndoc.BodyP0(0)
stmp= TokentoValue(stmp, doc,False)
Call rtItem.AppendText(stmp)
Call rtItem.AddNewLine( 2 )
Call rtItem.AppendRTItem(rt)
If ndoc.TestMode(0)="1" Then
doc2.subject =doc.co_CompanyEmail(0) + ndoc.subject(0)
doc2.sendto=session.username
Else
doc2.subject = ndoc.subject(0)
doc2.sendto=doc.co_CompanyEmail(0)
If ndoc.BlindCopy(0)="1" Then
doc2.BlindCopyTo="IM"
End If
End If
doc2.form = "Memo"
Call doc2.send(False) 'Hier tritt der Fehler auch auf
%REM
Set doc2 = db2.createdocument
Set rt = doc2.createrichtextitem("Body")
Call rt.AppendDocLink( mdoc, "Link zum Massenmail" , "Link zum Massenmail")
doc2.subject = ndoc.subject
doc2.in_icon = 140
doc2.tm_AdressInfo = doc.universalid
doc2.sendto=doc.co_CompanyEmail(0)
doc2.form = "MEMail"
doc2.is_MassMail= "1"
doc2.ComputeWithForm False, False
Call BEAdressOver( doc2 ) '
doc2.ComputeWithForm False, False
Call zugriff(doc2)
Call doc2.save(False,False)
%END REM
End If
Set doc=coll.getnextdocument (doc)
Loop
wk.currentdocument.close
End Sub
Call rt.CopyItemToDocument( doc2, "Body" )
call doc2.CreateRichTextItem("Body")
davorzusetzen, aber er will nicht!?
.... aus der Designer-Hilfe:
This script creates a new rich text item called ProjectDescription and adds a text value to it.
Dim doc As NotesDocument
Dim rtitem As NotesRichTextItem
'...set value of doc...
Set rtitem = doc.CreateRichTextItem( "ProjectDescription" )
Call rtitem.AppendText( "Book for children ages 9-12" )
Call doc.Save( False, True )
Dim session As New NotesSession
Dim db As NotesDatabase
Dim doc As NotesDocument
Dim memo As NotesDocument
Dim itemA As NotesItem
Dim itemB As NotesItem
Set db = session.CurrentDatabase
'...set value of doc...
Set itemA = doc.GetFirstItem( "Body" )
Set itemB = doc.GetFirstItem( "BriefDescription" )
Set memo = New NotesDocument( db )
Call itemA.CopyItemToDocument( memo, "Body" )
Call itemB.CopyItemToDocument( memo, "Subject" )
Call memo.Send( False, "Cynthia Brainey" )
aber habe den Fehler gerade gefunden (RTI wird schon beim Erstellen der Vorlage falsch übergeben)
Danke an alle :)