Hi ich muss euch nochmalss belästigen mit nem Problem.
Ich sitze jetzt schon den halben Tag an einem miesenProblem und habe auch hier im Forum noch keine wirklcihe Lösung gefunden.
Folgendes:
Ich habe ein Dokument welches mit einem RT Feld gefüllt wird... dafür muss ich nen Reopen machen. Das RTF wird auch super gefüllt und läuft reibungslos, jedoch wenn ich ein bestehendes Dokument öffne da was ändere und dann speichern sage, bekomme ich folgende Fehlermeldung:
"Eine weitere Kopie dieses Dokumentes wurde gespeichert, während Sie das Dokment bearbeiteten. Sollen Ihre Ä'nderungen auch als Konfliktdokument gespeichert werden?"
Anbei noch der Code, hoffe Ihr könnt mir helfen.
POSTOPEN:
Sub Postopen(Source As Notesuidocument)
Dim session As New NotesSession
Dim db As NotesDatabase
Dim doc As NotesDocument
Dim profiledoc As NotesDocument
Dim workspace As New NotesUIWorkspace
Set db = session.CurrentDatabase
Dim uidoc As NotesUIDocument
Set doc = source.Document
Set uidoc=source
doc.saveoptions=0
Call doc.Save(True,False)
Call uidoc.Refresh
If doc.Tabelle(0) = "0" Then
Call Tabelle(uidoc)
doc.Tabelle = "1"
Call uidoc.Close
Set doc = Nothing
Set doc = source.Document
Set uidoc = workspace.EditDocument(True,doc)
Else
doc.RemoveItem("SaveOptions")
End If
doc.Tabelle = "0"
Call doc.Save(True,False)
Call uidoc.refresh
Call uidoc.Reload
End Sub
Funktion Tabelle:
Sub Tabelle(uidocu As NotesUIDocument)
REM Normale Deklaration
Dim workspace As New NotesUIWorkspace
Dim session As New NotesSession
Dim uidoc2 As NotesUIDocument
Dim doc2 As NotesDocument
Dim db As NotesDatabase
Dim item As NotesItem
REM Mail Deklarationen
Dim DocSend As NotesDocument
Dim rtitem As NotesRichTextItem
Dim richStyle As NotesRichTextStyle
Set richStyle = session.CreateRichTextStyle
REM Setzten der Standardwerte
Set uidoc2 = uidocu
Set db = session.CurrentDatabase
Set doc2 = uidoc2.Document
Set richStyle = session.CreateRichTextStyle
Set DocSend = New NotesDocument(db)
Set rtitem = New NotesRichTextitem(DocSend, "rtbody")
Dim commonuser As String
commonuser = session.CommonUserName
REM Sonstiges
Dim Schluessel As String
REM \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ CODE \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/
doc2.saveoptions = "0"
Dim view As NotesView
Dim view4 As NotesView
Dim doc3 As NotesDocument
Dim entry As NotesViewEntry
Dim vc As NotesViewEntryCollection
Dim dc As NotesDocumentCollection
Dim doc4 As NotesDocument
Set view = db.GetView("aFehler")
'Deklarationen
Set rtbody = New NotesRichTextItem(doc2, "RTFELD")
Call CorrectItemRemove(doc2,"rtFeld")
Set rtbody = New NotesRichTextItem(doc2, "RTFELD")
Call view.Refresh
If view.EntryCount > 0 Then
Set vc = view.GetAllEntriesByKey(doc2.PName(0))
Set entry = vc.GetFirstEntry
End If
If Not entry Is Nothing Then
Set doc3 = entry.Document 'col.GetNextDocument(doc2)
Do Until doc3 Is Nothing
'Texte einfügen
Call rtbody.appendtext(doc3.Created)
Call rtbody.AddTab(1)
richStyle.Bold = True
Call rtbody.AppendStyle(richStyle)
Call rtbody.AppendText(doc3.Subject(0))
richStyle.Bold = False
Call rtbody.AppendStyle(richStyle)
Call rtbody.AddNewline(1)
Call rtbody.AddTab(3)
richstyle.Italic = True
Call rtbody.AppendStyle(richStyle)
Call rtbody.AppendText(Cstr(doc3.Autor(0)))
richstyle.Italic = False
Call rtbody.AppendStyle(richStyle)
Call rtbody.AddNewline(2)
richStyle.Bold = True
Call rtbody.AppendStyle(richStyle)
Call rtbody.AppendText("Fehlerbeschreibung:")
richStyle.Bold = False
Call rtbody.AppendStyle(richStyle)
Call rtbody.addnewline(1)
Call rtbody.AppendText(doc3.Fehler(0))
Call rtbody.AddNewline(2)
richStyle.Bold = True
Call rtbody.AppendStyle(richStyle)
Call rtbody.AppendText("Fehlerbehebung:")
richStyle.Bold = False
Call rtbody.AppendStyle(richStyle)
Call rtbody.addnewline(1)
Call rtbody.AppendText(doc3.Loesung(0))
Dim anhange As NotesRichTextItem
Set Anhange = doc3.GetFirstItem("Anhange")
If Not Isempty(anhange.EmbeddedObjects) Or Not (doc3.anhange = "" Or doc3.anhange = " ") Then
Call rtbody.AddNewline(2)
richstyle.FontSize = 8
richstyle.Underline = True
Call rtbody.AppendStyle(richStyle)
Call rtbody.AppendText("Anhänge:")
richstyle.FontSize = 10
richstyle.Underline = False
Call rtbody.AppendStyle(richStyle)
Call rtbody.AddNewline(1)
End If
Call rtbody.AppendRTItem(Anhange)
Set entry = vc.GetNextEntry(entry)
If Not entry Is Nothing Then
Call rtbody.AddNewline(1)
Call rtbody.AppendText("-------------------------------------------------------------------------------------------------------------------------------------------------------")
Call rtbody.AddNewline(1)
Set doc3 = entry.Document 'col.GetNextDocument(doc2)
Else
Set doc3 = Nothing
End If
Loop
End If
Call uidocu.Close
End Sub
Funktion zum leeren des RTFeldes:
Sub CorrectItemRemove (doc As NotesDocument, ItemName As String)
Dim ItemToRemove
Set ItemToRemove = doc.GetFirstItem (ItemName)
If ItemToRemove Is Nothing Then Exit Sub
If ItemToRemove.Type = 1 Then
Dim Embeddings
Dim ObjectToRemove As NotesEmbeddedObject
Embeddings = ItemToRemove.EmbeddedObjects
While Isarray (Embeddings)
Set ObjectToRemove = Embeddings (0)
Call ObjectToRemove.Remove
Embeddings = ItemToRemove.EmbeddedObjects
Wend
End If
Call ItemToRemove.Remove
End Sub
Jetzt nochmal alle docs etc. auf den selbe nnamen gebracht. Läuft immernoch bis auf den Fehler wie oben genannt.
Sub Postopen(Source As Notesuidocument)
Dim session As New NotesSession
Dim db As NotesDatabase
Set db = session.CurrentDatabase
Dim doc As NotesDocument
Set doc = source.Document
Dim profiledoc As NotesDocument
Dim workspace As New NotesUIWorkspace
Dim uidoc As NotesUIDocument
Set uidoc=source
doc.saveoptions=0
Call doc.Save(True,False)
Call uidoc.Refresh
If doc.Tabelle(0) = "0" Then
Call Tabelle(uidoc)
doc.Tabelle = "1"
Call uidoc.Close
Set doc = Nothing
Set doc = source.Document
Set uidoc = workspace.EditDocument(True,doc)
Else
doc.RemoveItem("SaveOptions")
End If
doc.Tabelle = "0"
Call doc.Save(True,False)
Call uidoc.refresh
End Sub
Sub Tabelle(uidoc As NotesUIDocument)
REM Normale Deklaration
Dim workspace As New NotesUIWorkspace
Dim session As New NotesSession
Dim doc As NotesDocument
Dim db As NotesDatabase
Dim item As NotesItem
Dim richStyle As NotesRichTextStyle
Set richStyle = session.CreateRichTextStyle
REM Setzten der Standardwerte
Set db = session.CurrentDatabase
Set doc = uidoc.Document
Set richStyle = session.CreateRichTextStyle
Set DocSend = New NotesDocument(db)
Dim commonuser As String
commonuser = session.CommonUserName
REM \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ CODE \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/
doc.saveoptions = "0"
Dim view As NotesView
Dim doc2 As NotesDocument
Dim entry As NotesViewEntry
Dim vc As NotesViewEntryCollection
Dim dc As NotesDocumentCollection
Set view = db.GetView("aFehler")
Set rtbody = New NotesRichTextItem(doc, "RTFELD")
Call CorrectItemRemove(doc,"rtFeld")
Set rtbody = New NotesRichTextItem(doc, "RTFELD")
Call view.Refresh
If view.EntryCount > 0 Then
Set vc = view.GetAllEntriesByKey(doc.PName(0))
Set entry = vc.GetFirstEntry
End If
If Not entry Is Nothing Then
Set doc2 = entry.Document
Do Until doc2 Is Nothing
Call rtbody.appendtext(doc2.Created)
Call rtbody.AddTab(1)
richStyle.Bold = True
Call rtbody.AppendStyle(richStyle)
Call rtbody.AppendText(doc2.Subject(0))
richStyle.Bold = False
Call rtbody.AppendStyle(richStyle)
Call rtbody.AddNewline(1)
Call rtbody.AddTab(3)
richstyle.Italic = True
Call rtbody.AppendStyle(richStyle)
Call rtbody.AppendText(Cstr(doc2.Autor(0)))
richstyle.Italic = False
Call rtbody.AppendStyle(richStyle)
Call rtbody.AddNewline(2)
richStyle.Bold = True
Call rtbody.AppendStyle(richStyle)
Call rtbody.AppendText("Fehlerbeschreibung:")
richStyle.Bold = False
Call rtbody.AppendStyle(richStyle)
Call rtbody.addnewline(1)
Call rtbody.AppendText(doc2.Fehler(0))
Call rtbody.AddNewline(2)
richStyle.Bold = True
Call rtbody.AppendStyle(richStyle)
Call rtbody.AppendText("Fehlerbehebung:")
richStyle.Bold = False
Call rtbody.AppendStyle(richStyle)
Call rtbody.addnewline(1)
Call rtbody.AppendText(doc2.Loesung(0))
Dim anhange As NotesRichTextItem
Set Anhange = doc2.GetFirstItem("Anhange")
If Not Isempty(anhange.EmbeddedObjects) Or Not (doc2.anhange = "" Or doc2.anhange = " ") Then
Call rtbody.AddNewline(2)
richstyle.FontSize = 8
richstyle.Underline = True
Call rtbody.AppendStyle(richStyle)
Call rtbody.AppendText("Anhänge:")
richstyle.FontSize = 10
richstyle.Underline = False
Call rtbody.AppendStyle(richStyle)
Call rtbody.AddNewline(1)
End If
Call rtbody.AppendRTItem(Anhange)
Set entry = vc.GetNextEntry(entry)
If Not entry Is Nothing Then
Call rtbody.AddNewline(1)
Call rtbody.AppendText("-------------------------------------------------------------------------------------------------------------------------------------------------------")
Call rtbody.AddNewline(1)
Set doc2 = entry.Document
Else
Set doc2 = Nothing
End If
Loop
End If
Call uidoc.Close
End Sub
bei der Funktion "CorrectItemRemove" hab ich nix geändert
schonmal danke für eure mühe aber bisher hab ich immernoch das selbe Problem.
Hier nochmal der COde erneut überarbeitet
Sub Postopen(Source As Notesuidocument)
Dim session As New NotesSession
Dim workspace As New NotesUIWorkspace
Dim db As NotesDatabase
Set db = session.CurrentDatabase
Dim doc As NotesDocument
Set doc = source.Document
Dim uidoc As NotesUIDocument
Set uidoc=source
doc.saveoptions=0
Call doc.Save(True,False)
Call uidoc.Refresh
If doc.Tabelle(0) = "0" Then
Call Tabelle(doc,workspace,session)
doc.Tabelle = "1"
Call doc.Save(True,False)
Call uidoc.Close
Set uidoc = workspace.EditDocument(True,source.Document)
Else
doc.RemoveItem("SaveOptions")
End If
doc.Tabelle = "0"
Call doc.Save(True,False)
Call uidoc.refresh
End Sub
Sub Tabelle(doc As NotesDocument,workspace As NotesUIWorkspace,session As NotesSession)
REM Normale Deklaration
Dim db As NotesDatabase
Set db = session.CurrentDatabase
Dim richStyle As NotesRichTextStyle
Set richStyle = session.CreateRichTextStyle
Dim view As NotesView
Set view = db.GetView("aFehler")
Dim doc2 As NotesDocument
Dim entry As NotesViewEntry
Dim vc As NotesViewEntryCollection
Dim dc As NotesDocumentCollection
Dim anhange As NotesRichTextItem
REM \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ CODE \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/ \/
Set rtbody = New NotesRichTextItem(doc, "RTFELD")
Call CorrectItemRemove(doc,"rtFeld")
Set rtbody = New NotesRichTextItem(doc, "RTFELD")
Call view.Refresh
If view.EntryCount > 0 Then
Set vc = view.GetAllEntriesByKey(doc.PName(0))
Set entry = vc.GetFirstEntry
End If
If Not entry Is Nothing Then
Set doc2 = entry.Document
Do Until doc2 Is Nothing
Call rtbody.appendtext(doc2.Created)
Call rtbody.AddTab(1)
richStyle.Bold = True
Call rtbody.AppendStyle(richStyle)
Call rtbody.AppendText(doc2.Subject(0))
richStyle.Bold = False
Call rtbody.AppendStyle(richStyle)
Call rtbody.AddNewline(1)
Call rtbody.AddTab(3)
richstyle.Italic = True
Call rtbody.AppendStyle(richStyle)
Call rtbody.AppendText(Cstr(doc2.Autor(0)))
richstyle.Italic = False
Call rtbody.AppendStyle(richStyle)
Call rtbody.AddNewline(2)
richStyle.Bold = True
Call rtbody.AppendStyle(richStyle)
Call rtbody.AppendText("Fehlerbeschreibung:")
richStyle.Bold = False
Call rtbody.AppendStyle(richStyle)
Call rtbody.addnewline(1)
Call rtbody.AppendText(doc2.Fehler(0))
Call rtbody.AddNewline(2)
richStyle.Bold = True
Call rtbody.AppendStyle(richStyle)
Call rtbody.AppendText("Fehlerbehebung:")
richStyle.Bold = False
Call rtbody.AppendStyle(richStyle)
Call rtbody.addnewline(1)
Call rtbody.AppendText(doc2.Loesung(0))
Set Anhange = doc2.GetFirstItem("Anhange")
If Not Isempty(anhange.EmbeddedObjects) Or Not (doc2.anhange = "" Or doc2.anhange = " ") Then
Call rtbody.AddNewline(2)
richstyle.FontSize = 8
richstyle.Underline = True
Call rtbody.AppendStyle(richStyle)
Call rtbody.AppendText("Anhänge:")
richstyle.FontSize = 10
richstyle.Underline = False
Call rtbody.AppendStyle(richStyle)
Call rtbody.AddNewline(1)
End If
Call rtbody.AppendRTItem(Anhange)
Set entry = vc.GetNextEntry(entry)
If Not entry Is Nothing Then
Call rtbody.AddNewline(1)
Call rtbody.AppendText("-------------------------------------------------------------------------------------------------------------------------------------------------------")
Call rtbody.AddNewline(1)
Set doc2 = entry.Document
Else
Set doc2 = Nothing
End If
Loop
End If
End Sub
Hi,
hängt wohl damit zusammen, dass du nicht wirklich das "Backend-Dokument" neu geladen vorliegen hast.
Ich weiss zwar nicht, wie dein Code mittlerweile aussieht, aber im bisherigen muss der "reopen" nach dem doc.save() erfolgen!
doc.Tabelle = "0"
Call doc.Save(True,False)
' hier der reopen
Call uidoc.refresh
End Sub
Anderer Ansatz:
Pack den code in den QueryOpen.
Dann brauchtst du den reopen eventuell nicht.
Gruss Pete(r)
----------- so noch ein nachtrag:
wenn dein code immernoch so ist:
Set uidoc = workspace.EditDocument(True,source.Document)
Else
doc.RemoveItem("SaveOptions")
End If
doc.Tabelle = "0"
Call doc.Save(True,False)
Call uidoc.refresh
End Sub
ist der Fehler, dass Du nach dem
Set uidoc = workspace.EditDocument(True,source.Document)
noch ein save auf das Hintergrund-doc machst:
Call doc.Save(True,False)
ich glaub Dir ist da die End if verrutscht:
Else
doc.RemoveItem("SaveOptions")
' nicht hier: End If
doc.Tabelle = "0"
Call doc.Save(True,False)
Call uidoc.refresh
End If ' sonder hier
aber ein paar der doc.save's kannst du sicher noch weglassen....