Ok, hier ein wenig mehr Code:
Dim ws As New NotesUIWorkspace
Dim uidoc As NotesUIDocument
Dim doc As NotesDocument
Dim parentDoc As NotesDocument
Dim parentDB As NotesDatabase
Dim rtitem As NotesRichTextItem
Dim jobRTItem As NotesRichTextItem
Dim bakRTItem As NotesRichTextItem
Dim dlgRTItem As NotesRichTextItem
Dim rtItemIsNewItem As Integer
Dim dlgRTItemIsEmpty As Integer
Dim success As Integer
Dim tmpText As String
Dim newJobDoc As NotesDocument
Dim tmpUIDoc As NotesUIDocument
Dim orgSourceDoc As NotesDocument
Dim Key As Variant
Dim table As NotesRichTextTable
Dim Header As Variant
Dim Fields As Variant
Dim i As Integer
Dim navi As NotesRichTextNavigator
Dim flage As Integer
Dim Field As String
Dim JobDoc As NotesDocument
Set uidoc = ws.CurrentDocument
Set doc = uidoc.Document
Set parentDB = doc.ParentDatabase
Set parentDoc = parentDB.GetDocumentByUNID(doc.ParentDocUNIDT(0))
rtItemIsNewItem = False
Set rtitem = parentDoc.GetFirstItem("BodyRT")
If (rtitem Is Nothing) Then
Set rtitem = New NotesRichTextItem(parentDoc, "BodyRT")
rtItemIsNewItem = True
Else
tmpText = rtItem.GetFormattedText( True, 80)
If tmpText = "" Then
rtItemIsNewItem = True
End If
End If
Set navi = rtitem.CreateNavigator
key = getKeyWord(".SalesProtocolTable",True)
Redim Header(Ubound(Key))
Redim Fields(Ubound(Key))
i = 0
Forall x In Key
Header(i) = atword(x,"$",1)
Fields(i) = atword(x,"$",2)
i = i + 1
End Forall
If rtItemIsNewItem = True Then
'Hier wird die Tabelle im ersten Lauf erstellt
Else
If Not navi.findFirstElement(RTELEM_TYPE_TABLE) Then
Msgbox "Keine Tabelle"
Exit Sub
End If
Set Table = navi.GetElement
Call Table.AddRow(1)
Call navi.FindFirstElement(RTELEM_TYPE_TABLECELL)
i = 0
For r& = 1 To table.RowCount
If r& = Table.RowCount Then
For c& = 1 To table.ColumnCount
Call rtitem.BeginInsert(navi)
If c& = 1 Then
Call rtitem.AppendText(r&-1)
Else
Field = Fields(c&-1)
If doc.HasItem(Field) Then
Call rtitem.AppendText(doc.GetItemValue(Field)(0))
Else
If Field = "CreateDocLink" Then
Set JobDoc = ParentDB.GetDocumentByUNID(atWord(doc.HidJobInfoT,"$",1))
If Not JobDoc Is Nothing Then
Call rtitem.AppendDocLink(JobDoc,"")
End If
End If
End If
End If
Call rtitem.EndInsert
i = i + 1
Call navi.FindNextElement(RTELEM_TYPE_TABLECELL)
Next
End If
Next
End If
Call parentDoc.Save(True, False)
'*** Open parent document ***
Set tmpUIDoc = ws.EditDocument(False, parentDoc)
tmpUIDoc.EditMode = True
Call tmpuidoc.save
Das Problem liegt darin, das der Code für das Finden der Tabelle ja fast 1 zu 1 aus der Hilfe ist. Aber er funktioniert trotzdem nicht.
Im ersten Durchlauf funktioniert er allerdings direkt nach dem erstellen.
Sorry wenn das zu viel Code sein sollte. Aber ich denke so könnt ihr euch am ehesten ein Bild machen.
Danke nochmal
