Problem mit Konfliktdokumenten.... BITTE DRINGEND HILFE

Domino 9 und frühere Versionen > ND7: Entwicklung

(1/3) > >>

C_T:
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:

--- Code: ---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
--- Ende Code ---

Funktion Tabelle:

--- Code: ---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
--- Ende Code ---

Funktion zum leeren des RTFeldes:

--- Code: ---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
--- Ende Code ---

Thomas Schulte:
Mal so aus dem Bauch heraus:
Doc.save, Uidoc.refresh, Uidoc.close, uidocu.close (was das gleiche wie dein Uidoc.close ist), Doc.save, uidoc.refresh, uidoc.reload ..... Das ganze gemischt mit SaveOptions = "0" und gewürzt mit doc2 und doc3 in deiner Tabellen Sub.

Und da wunderst du dich wenn du diese Fehlermeldung bekommst?

Räum erst mal die ganzen Saves und Close in deinem Code auf. Dann wirst du feststellen, das der Fehler veschwindet.

C_T:
Jetzt nochmal alle docs etc. auf den selbe nnamen gebracht. Läuft immernoch bis auf den Fehler wie oben genannt.

--- Code: ---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

--- Ende Code ---

--- Code: ---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
--- Ende Code ---

bei der Funktion "CorrectItemRemove" hab ich nix geändert

Thomas Schulte:
Ist ja auch logisch, weil du immer noch nicht aufgeräumt hast.

Nimm doch erst einmal dein uidoc.close aus deiner Tabellen Routine raus.

Axel:
So richtig aufgeräumt hast du aber nicht.

Warum übergibst du der Routine Tabelle das uidoc und initialiserst dann noch mal eine Variable doc, obwohl du die in Postopen schon hast? Du arbeitest dann, wenn ich das richtig sehe mit zwei "Instanzen" des gleichen Dokumentes. Da kann nicht gut gehen.

Und was soll das uidoc.close in der Routine Tabelle?

Übergib der Routine das doc aus Postopen und arbeite damit weiter.

Axel

Navigation

[0] Themen-Index

[#] Nächste Seite

Zur normalen Ansicht wechseln