Autor(en): | Mathias (TMC) |
Stand: | 22.09.2005 |
Version: | 1.3 |
Notes-Versionen: | 5.x, 6.x, 7.x |
Änderungen: | Version Datum Geändert von Grund 1.3 22.03.2007 Axel Fehlerbereinigung in Code unter Punkt 3.9 |
@If(Form = "";
@Return(@Prompt( [OK];@DbTitle; "Bitte wählen Sie ein Hauptdokument aus" + @Char(13) + "um ein Antwortdokument zu erstellen."));
@Success
);
@If(@IsResponseDoc;
@Prompt( [OK];@DbTitle; "Bitte wählen Sie ein Hauptdokument aus" + @Char(13) + "um ein Antwortdokument zu erstellen.");
@Command([Compose]; "RESPONSE MASKE")
)
@If(Form = "";
@Return(@Prompt( [OK];@DbTitle; "Bitte wählen Sie ein Hauptdokument aus" + @Char(13) + "um ein Antwortdokument zu erstellen."));
@Success
);
@Command([Compose]; "RESPONSE MASKE")
@If(@IsNewDoc;"";@GetDocField($REF;"FELD"))
Sub Querysave(Source As Notesuidocument, Continue As Variant)
'------------------------------------------------------------------------------------------------------------------
'Zweck: Feldwerte werden beim Speichern in alle Antwort-Dokumente übernommen
'------------------------------------------------------------------------------------------------------------------
Dim session As New NotesSession
Dim db As NotesDatabase
Dim dc As NotesDocumentCollection
Dim doc As NotesDocument
Set db = session.CurrentDatabase
If Source.IsNewDoc Then Exit Sub 'Wenn UIDoc neu ist dann verlasse Script
Set doc = Source.Document 'UIDoc zu Backend-doc
'alle Antwortdocs des Backend-Docs werden in die Collection aufgenommen
Set dc = doc.Responses
'Setze alle Felder der Collection, gespeichert wird automatisch
Call dc.StampAll( "Re_Feld1" , doc.Feld1(0) )
Call dc.StampAll( "Re_Feld2" , doc.Feld2(0) )
Call dc.StampAll( "Re_Feld3" , doc.Feld3(0) )
End Sub
Dim docParent As NotesDocument
Set docParent = db.getDocumentByUNID("UNID-String")
Call doc.RemoveItem("$Ref")
Call doc.MakeResponse( docParent )
SubjectParent + "~" + @Text(@DocumentUniqueID)
Sub Click(Source As Button)
Const ITEMNAME_TITLE_OF_PARENT$ = "SubjectParent"
Const VIEWNAME_LOOKUP_PARENT$ = "($Lookup_AssigningOtherParent)"
Const DELIMITER_TITLE_UNID$ = "~"
Const COLUMN_NO_LOOKUP$ = "3" 'which column contains the subject + delimiter + UNID ?
Const MSGPICKLIST_TITLE$ = "Document selection"
Const MSGPICKLIST_TEXT$ = "Please select a main document to which you want to assign this response document:"
Const ERRMSG_1001$ = "Current document is not a response."
Const ERRMSG_1002$ = "Current document is not in edit mode."
Const ERRMSG_LINE2$ = "Operation has been canceled."
On Error Goto ErrorHandler
Dim session As New NotesSession
Dim uiws As New NotesUIWorkspace
Dim uidoc As NotesUIDocument
Dim db As NotesDatabase
Dim docCur As NotesDocument
Dim docParent As NotesDocument
Dim vPicklistReturn As Variant
Dim strLeftValue As String
Dim strRightValue As String
Dim i As Integer
Set db = session.CurrentDatabase
Set uidoc = uiws.CurrentDocument
Set docCur = uidoc.Document
'Only continue if the current document is a response & if it is in the edit mode
If Not docCur.IsResponse Then Error 1001, ERRMSG_1001
If Not uidoc.EditMode Then Error 1002, ERRMSG_1002
'Display the main documents and let the user select one
vPicklistReturn =uiws.Pickliststrings(PICKLIST_CUSTOM, False, db.Server, db.FilePath,VIEWNAME_LOOKUP_PARENT,_
MSGPICKLIST_TITLE, MSGPICKLIST_TEXT, COLUMN_NO_LOOKUP)
If Isempty(vPicklistReturn) Then Goto GoOut 'user did not select a document
'Get left and right value
strLeftValue = Strleft(vPicklistReturn(0), DELIMITER_TITLE_UNID)
strRightValue = Strright(vPicklistReturn(0), DELIMITER_TITLE_UNID)
'Set subject of main document to an item of the current response document
Call docCur.ReplaceItemValue(ITEMNAME_TITLE_OF_PARENT, strLeftValue)
'Assign the new main document to the current response doczment
Set docParent = db.getDocumentByUNID(strRightValue)
Call docCur.RemoveItem("$Ref")
Call docCur.MakeResponse( docParent )
'Refresh
Call uidoc.Reload
Call uidoc.Refresh
GoOut:
Exit Sub
ErrorHandler:
Select Case Err
Case 1001 To 1999: 'User defined errors
Msgbox Error$ & Chr(10) & Chr(10) & ERRMSG_LINE2, 64, db.Title
Resume GoOut
Case Else:
ErrorMsg ' Your error sub. See this AtNotes thread for further information: http://www.atnotes.de/index.php?topic=11980.0
Resume GoOut
End Select
End Sub
Sub Click(Source As Button)
'Constants for this procedure
Const FORMNAME_RESPONSE$ = "frmTest"
Const ERR_NODOCSEL_TITLE$ = "Error: No document selected"
Const ERR_NODOCSEL_MSG$ = "You need to select a document to create a response document of it."
On Error Goto ErrorHandler 'Of course we trap errors
'The dim section
Dim uiws As New NotesUIWorkspace
Dim uidocNew As NotesUIDocument
Dim session As New NotesSession
Dim db As NotesDatabase
Dim docSel As NotesDocument
Dim docNew As NotesDocument
'We need the current database
Set db = session.CurrentDatabase
'Get current document as NotesDocument object
If Not uiws.CurrentDocument Is Nothing Then
Set docSel = uiws.CurrentDocument.Document 'Document opened in form
Elseif Not session.DocumentContext Is Nothing Then
Set docSel = session.DocumentContext 'Document selected in view
End If
If docSel Is Nothing Then 'User did not select a document
Msgbox ERR_NODOCSEL_MSG, 48, ERR_NODOCSEL_TITLE
Goto GoOut
End If
'Create new backend response document
Set docNew = db.CreateDocument
Call docNew.ReplaceItemValue("Form", FORMNAME_RESPONSE)
Call docNew.MakeResponse(docSel)
'This is necessary since we use one form for both main and response documents
Call docNew.ReplaceItemValue("$VersionOpt","1")
'Finally, open new document in the frontend
Call uiws.EditDocument(True, docNew)
GoOut:
Exit Sub
ErrorHandler:
ErrorMsg ' Your error sub. See this AtNotes thread for further information: http://www.atnotes.de/index.php?topic=11980.0
Resume GoOut
End Sub
Dim doc As NotesDocument
Dim collection As NotesDocumentCollection
Set collection = Source.Documents
If collection.Count > 0 Then
For i = 1 To collection.Count
Set doc = collection.GetNthDocument(i)
Call DeleteResponseDocs(doc)
Call doc.Remove(True)
Next 'For i = 1 To collection.Count
End If 'If collection.Count = 0 Then
Sub DeleteResponseDocs (doc As NotesDocument)
'This is a recursive sub to access all the descendants of a particular document.
Dim collResponses As NotesDocumentCollection
Dim docTemp As NotesDocument
Dim docDummy As NotesDocument
Set collResponses = doc.Responses
Set docDummy= collResponses.GetFirstDocument
While Not (docDummy Is Nothing)
Set docTemp = collResponses.GetNextDocument(docDummy)
Call DeleteResponseDocs(docDummy) 'The recursive call
Call docDummy.Remove(True)
Set docDummy = docTemp
Wend 'While Not (docDummy Is Nothing)
End Sub