So ähnlich:
Sub Initialize
Dim ws As New NotesUIWorkspace
Dim session As New NotesSession
Dim doc As NotesDocument
Dim uidoc As NotesUIDocument
Dim docNew As NotesDocument
Dim view As NotesView
Dim dc As NotesDocumentCollection
Dim db As NotesDatabase
Dim strDBName As String
Dim collection As NotesDocumentCollection
Dim docColl As NotesDocument
Dim intI As Integer
Dim strServer As String
Dim strView As String
Dim strMail As String
Dim rtitemA As Variant
Dim rtitemB As Variant
Dim varDummy As Variant
Dim richStyle As NotesRichTextStyle
'Set uidoc = ws.currentDocument
Set richStyle = session.CreateRichTextStyle
strMail= session.GetEnvironmentString( "MailFile" , True)
strView = "$Inbox"
strServer = "Servername"
strDBName = strMail
'Set doc = uidoc.document
Set db = session.CurrentDatabase
Set collection = ws.PickListCollection( PICKLIST_CUSTOM, True, strServer, strDBName, strView, "Mailauswahl", "Bitte wählen Sie eine Mail aus")
If collection Is Nothing Then
Msgbox "gecancelt"
Else
Set docColl = collection.GetFirstDocument
If docColl Is Nothing Then
Exit Sub
Else
Do While Not docColl Is Nothing
Set docNew = db.createDocument
docNew.form = "Topic1"
Set rtitem = New NotesRichTextItem( docNew, "DawText" )
richStyle.Bold = True
Call rtitem.AppendStyle(richStyle)
Call rtitem.AppendText( "Absender" )
Call rtitem.AddNewLine( 1 )
Call rtitem.AppendText( docColl.from(0) )
Call rtitem.AddNewLine( 1 )
Call rtitem.AppendText( "Datum" )
Call rtitem.AddNewLine( 1 )
If docColl.HasItem( "DeliveredDate" ) Then
Call rtitem.AppendText( docColl.DeliveredDate(0) )
Else
Call rtitem.AppendText( docColl.PostedDate(0) )
End If
richStyle.Bold = False
Call rtitem.AppendStyle(richStyle)
Call rtitem.AddNewLine( 2 )
Set rtitemA = docColl.GetFirstItem( "Body" )
Set rtitemB = docNew.GetFirstItem( "DawText" )
If ( rtitemA.Type = RICHTEXT And _
rtitemB.Type = RICHTEXT ) Then
Call rtitemB.AppendRTItem( rtitemA )
End If
docNew.Kategorie_1 = docColl.Subject(0)
Call docNew.save (True, True)
Set docColl = collection.getNextDocument (docColl)
Loop
End If
End If
Set view = db.GetView("Themen_Alle")
Call view.Refresh
End Sub