mach ich doch glatt
ist jetzt nicht ganz die "schöne" Lösung aber für das was realisiert werden soll reichts.
Gruss
Thomas
Ich hoffe das ist jetzt so OK
Sub Initialize
Dim session As New NotesSession
Dim ndb As NotesDatabase
Dim view As NotesView
Dim doc As NotesDocument
Dim docMemo As NotesDocument
Dim origbody As NotesRichTextItem
Dim item As NotesItem
Set ndb = session.CurrentDatabase
Set view = ndb.GetView( "(AnfageUnBeantwortet)" )
Set doc = view.GetFirstDocument
view.AutoUpdate = False
'Verarbeitung Busunternehmen
While Not(doc Is Nothing)
If Not doc.beantwortet(0)= "ja" Then
'Betreff von Originalmail aufteilen
SubjectMail = StrRightBack(doc.subject(0), "r - " )
sendto = StrrightBack(SubjectMail, " - " )
Bearbeitungsnummer = StrLeftBack(SubjectMail, "- " )
'erstellen neue nachricht + füllen felder
Set docmemo = doc.CreateReplyMessage( False )
docMemo.Form = "Memo"
docMemo.sendto = sendto
docMemo.From = "xxxs@xxx.de"
docMemo.ReplyTo = "xxx@xxx.de"
docMemo.Subject = "Neues Feedback Qualitätsmamagement - " + Bearbeitungsnummer
Set nrit = New NotesRichTextItem( docMemo, "Body" )
Call nrit.AppendText( "Sehr geehrter,")
Call nrit.AddNewLine( 2 )
Call nrit.AppendText( "es ist ein neues Feedback über das Qualitätsmanagement eingegangen." )
Call nrit.AddNewLine( 4 )
Call nrit.AppendText( "************** Feedback über QMS ****************" )
Call nrit.AddNewLine( 2 )
'Feedback aus originalmail in neue mail einfügen
Set origBody = doc.getfirstitem("Body")
If Not OrigBody Is Nothing Then
Call nrit.appendRtitem(OrigBody)
End If
'senden an Bus + verschieben in ordner + setzten verarbeitet flag
Call docMemo.Send(False)
Call docMemo.Save( True , False, True )
Call docMemo.MarkRead()
Call docMemo.PutInFolder("Mail an xxxx")
doc.beantwortet = "ja"
Call doc.Save( False, False, True )
Call doc.PutInFolder( "Mail an xxxx" )
Call doc.RemoveFromFolder( "$Inbox")
End If
Set doc = view.GetNextDocument(doc)
Wend
End Sub