Subject: RE: Without some clue what the rest of your code is, it’s impossible to say.
Hello,
I did try to trap this error… and I wrote values in the AgentLog to make sure everything was fine… and all is OK. All is working as expected, except that in some time, the line “Call outline.Save()” give this error. All this by doing the exact same action… so I was unable to find something in common about the cases that fail.
And the fact that I have two copies of the exact same database, on two different servers with the exact same Domino version, and that I have the problem with only one tend to prove that my code is correct.
Could that happen when two users are saving the same outline at the same time?
Here’s my complete code. (Sorry to have not included it in the first place… it is quite long):
Sub Initialize
'Access current database
Dim session As New NotesSession
Dim db As NotesDatabase
Set db = session.CurrentDatabase
Dim currentLog As New NotesLog(db.Title + " - openFolder")
Call currentLog.OpenNotesLog( "","AgentLog.nsf")
currentLog.LogAction("Agent Started")
'Access context document
Dim docContext As NotesDocument
Set docContext =session.DocumentContext
Dim query As String
query = docContext.Query_String_Decoded(0)
'Access CGI variables
Dim project_id As String, path As String, lang As String, mode As String
Dim hideActionBar As String, hidePathBar As String, hideMargin As String, widthX As String, heightY As String
project_id = ParseQS(query, "project_id=")
path = FindReplace(ParseQS(query, "path="), "/", "\")
lang = ParseQS(query, "lang=")
mode = ParseQS(query, "mode=")
hideActionBar = ParseQS(query, "hideActionBar=")
hidePathBar = ParseQS(query, "hidePathBar=")
hideMargin = ParseQS(query, "hideMargin=")
widthX = ParseQS(query, "width=")
heightY = ParseQS(query, "height=")
'Access current outline
Dim outline As NotesOutline
Set outline = db.GetOutline(project_id)
Dim entry As NotesOutlineEntry
'Get the entry of the current folder... create it if it doesn't exist (system folder)
Set entry = createFolders(project_id, path, outline, True)
'Create the appropriate URL
Dim url As String, dbName As Variant
Dim pos1 As Integer, pos2 As Integer
pos1 = Instr(entry.Url, "('")
pos2 = Instr(pos1+1, entry.Url, "')")
'Get the URL section.... (don't include the JavaScript function)
dbName = Evaluate("@WebDbName")
url = url + "/" + dbName(0) + Mid(entry.Url, pos1+2, pos2-pos1-2)
'Read/Edit mode
If mode <> "edit" Then
'Open the form/document in read mode only
If Instr(url, "!OpenForm") <> 0 Then
url = FindReplace(url, "!OpenForm", "!ReadForm")
Else
url = FindReplace(url, "!EditDocument", "!OpenDocument")
End If
End If
'Add remaining parameters
url = url + "&lang=" + lang + "&hideActionBar=" + hideActionBar + "&hidePathBar=" + hidePathBar + "&hideMargin=" + hideMargin + "&width=" + widthX + "&height=" + heightY + "&mode=" + mode
'Redirect to the appropriate URL
Print "Location: " + url
currentLog.LogAction(url)
currentLog.LogAction("Agent Finished")
End Sub
Function createFolders(project_id As String, folderPath As String, outline As NotesOutline, systemFolder As Integer) As NotesOutlineEntry
On Error Goto ErrorHandler
'Variables declaration and initialization
Dim entry As NotesOutlineEntry, existingEntry As NotesOutlineEntry
Dim parentEntry As NotesOutlineEntry, childEntry As NotesOutlineEntry, lastEntry As NotesOutlineEntry
Dim url As String, path As String
Dim singleArray(0) As String
Dim existingFolder As Integer, status As Integer, i As Integer
path=""
status=0
i=0
Dim folderArray As Variant
'Create an array with each sub-folders
folderArray = Fulltrim(Split(folderPath, "\"))
Set entry = outline.GetFirst
'Loop while there's a folder to read/create
Do While i <= Ubound(folderArray)
path = path + folderArray(i) + "/"
singleArray(0) = folderArray(i)
Set existingEntry = getFolder(outline, entry, singleArray, 0)
'If the folder has not been created yet...
If existingEntry Is Nothing Then
Set childEntry = outline.GetChild(parentEntry)
Do While (Not childEntry Is Nothing) And (status<>2)
If childEntry.Label > folderArray(i) Then
status=2
Else
status=1
Set lastEntry = childEntry
End If
'Read the next entry if it has not been found yet
If status <> 2 Then Set childEntry = outline.GetNextSibling(childEntry)
Loop
'... create a new folder
Select Case status
Case 0:
'There were no folder at the same level...
'... insert as the parent's first child
Set entry = outline.CreateEntry(folderArray(i), parentEntry, True, True)
Case 1:
'There were other folders at the same level...
'... but the current folder should be the last one (alpabetical order)
'Set entry = outline.CreateEntry(folderArray(i), lastEntry, True,False)
'Must use this syntax because there's a bug with the [addAfter] parameters of CreateEntry...
'... but the [addAfter] parameter of MoveEntry works fine.
Set entry = outline.CreateEntry(folderArray(i))
Call outline.MoveEntry(entry,lastEntry,True,False)
Case 2:
'There were other folders at the same level...
'... insert before another folder (alphabetical order)
'Set entry = outline.CreateEntry(folderArray(i), childEntry, False, False)
'Must use this syntax because there's a bug with the [addAfter] parameters of CreateEntry...
'... but the [addAfter] parameter of MoveEntry works fine.
Set entry = outline.CreateEntry(folderArray(i))
Call outline.MoveEntry(entry,childEntry,False,False)
End Select
'Copy the hide-when formula from the parent entry
entry.UseHideFormula = True
entry.HideFormula = parentEntry.HideFormula
'Assign an image and the default URL to this folder
If systemFolder = True Then
entry.ImagesText = "XfolderC.gif"
Else
entry.ImagesText = "folderC.gif"
End If
Set existingEntry = entry
'Add the complete folder path at the end of the URL
url = "/fa_file!OpenForm&project_id=" + project_id + "&path=" + FindReplace(path, Chr(39), "' + String.fromCharCode(39) + '")
Call entry.SetURL("javascript:void redirectToURL('" + url + "');")
Else
'All parent entries must be designed "System Folder" if the current entry is a "System Folder"
If systemFolder = True Then entry.ImagesText = "XfolderC.gif"
End If
status=0
'Keep an handle of the parent folder
Set parentEntry = entry
'Read the folder's child
Set entry = outline.GetChild(entry)
i=i+1
Loop
'Save the modified outline
Call outline.Save()
'Return the entry object
Set createFolders = existingEntry
Exit Function
ErrorHandler:
Print "Error " & Cstr(Err) & ": '" & Error$ & "' at line " & Cstr(Erl)
End Function
Function getFolder(outline As NotesOutline, entry As NotesOutlineEntry, folderArray As Variant, i As Integer) As NotesOutlineEntry
Dim found As Integer
found = False
If i <= Ubound(folderArray) Then
'Loop thru every folders on the same level
Do While (Not entry Is Nothing) And (found=False)
If entry.Label = folderArray(i) Then
'The found flag is used to stop the loop...
'... instead of looping thru all the entries
found=True
End If
'Read the next entry if it has not been found yet
If found <> True Then Set entry = outline.GetNextSibling(entry)
Loop
If found=True Then
i=i+1
Set lastEntry = entry
'Call that same function again with the folder's child
Set entry = getFolder(outline, outline.GetChild(entry),folderArray, i)
Else
'The current folder hasn't been created yet
Set lastEntry = Nothing
End If
End If
'Return the appropriate entry
Set getFolder = lastEntry
End Function
Thanks!