Partial replace design

How to replace any design element in ND6.

Read member feedback to this tip.

In ND6, we have the new class (NotesNoteCollection). This is a useful and powerful class to navigate, control and modify all database design and data documents.

I used this class to replace some design elements for specific requirements, such as company logo subforms, by sending a database to the client containing the logo design only and an action so that the client can click the action and then the logo design is replaced.

This routine is designed to replace any design element using a source and a target database. This routine requires designer ACL level or higher to be executed.
Here is a sample for using this call by an agent or a button

Sub Initialize 
        Const DesignDocType = "Forms" 
        Const CreateInTarget = True 
        Dim s As New NotesSession 
        Dim srcdb As NotesDatabase 
        Dim tgtdb As NotesDatabase 
        Dim DocTitles As Variant 
        Dim TargetPath As String 
        Redim DocTitles(0 To 1) 
        DocTitles(0) = "Form1" 
        DocTitles(1) = "Form2" 
        Set srcdb = s.CurrentDatabase 
        'Get your target database here 
        TargetPath = "C:NotesDataMyTargetFilePath" 
        If srcdb.QueryAccess(s.UserName) < ACLLevel_Designer Or
tgtdb.QueryAccess(s.UserName) < ACLLevel_Designer Then Msgbox "Your access level doesn't allow you to execute this action." Exit Sub End If Call ReplaceDesignElements(srcdb, tgtdb, DesignDocType, DocTitles,
CreateInTarget) End Sub '==================================================================== Public Sub ReplaceDesignElements(srcdb As NotesDatabase, tgtdb As NotesDatabase,
_ Byval DesignDocType As String, DocTitles As Variant, Byval CreateInTarget As Boolean) %REM This routine replaces predefined design elements of a database %ENDREM On Error Goto UnSeenError Dim Module As String Const LSI_THREAD_PROC = 1 Module = Getthreadinfo(LSI_THREAD_PROC) Const msgNoDesignNames = "Design names were not found in design elements in
database: " Dim srcTitles As Variant Dim tgtTitles As Variant Dim srcDocs() As NotesDocument Dim tgtDocs() As NotesDocument Dim srcdoc As NotesDocument Dim tgtdoc As NotesDocument Dim Index As Variant Dim ErrMsg As String Dim x As Long '==================================================================== If Not GetDesignDocuments(srcdb, DesignDocType, DocTitles, srcTitles, srcDocs,
ErrMsg) Then Goto Quit If Not GetDesignDocuments(tgtdb, DesignDocType, DocTitles, tgtTitles, tgtDocs,
ErrMsg) Then Goto Quit '==================================================================== For x = 0 To Ubound(DocTitles) Index = Arraygetindex(srcTitles, DocTitles(x)) If Not Isnull(Index)Then Set srcdoc = srcDocs(Index) Index = Arraygetindex(tgtTitles, DocTitles(x)) If Not Isnull(Index)Then Set tgtdoc = tgtDocs(Index) Call tgtdoc.Remove(True) Call srcdoc.CopyToDatabase(tgtdb) Else If CreateInTarget Then Call srcdoc.CopyToDatabase(tgtdb) End If End If End If Next Print "Finished replacing design elements." Exit Sub '==================================================================== UnSeenError: ErrMsg = "Unexpected error: In Line: (" & Erl & ") - Error No.: (" & Err & ") - Error
Name:" & _ Error$ & "In Module: (" & Module & ")." Exit Sub Quit: Msgbox ErrMsg, 16, Module End Sub '==================================================================== '==================================================================== Private Function GetDesignDocuments(db As NotesDatabase, Byval DesignDocType As
String, _ DocTitles As Variant, ReturnedTitles As Variant, DesignDocs() As NotesDocument,
ErrMsg As String) As Boolean Const CISPS = 5 'comparsion is CaseInsensitive - PichSensitive Dim nc As NotesNoteCollection Dim notedoc As NotesDocument Dim nid As String Dim Titles As Variant Dim NotFound As Boolean Dim x As Long, y As Long Set nc = db.CreateNoteCollection(False) Gosub SelectDesignTypeCollection If NotFound Then ErrMsg = "Design document type not found in the design types in database:"
& Chr$(10) & db.Server & "!!" & db.FilePath Exit Function End If Call nc.BuildCollection nid = nc.GetFirstNoteId y = 0 Redim ReturnedTitles(y) Redim DesignDocs(y) For x = 1 To nc.Count Set notedoc = db.GetDocumentByID(nid) If notedoc Is Nothing Then Goto GetNextNote REM the field $Title may take the imploded string of the element name
and it alias name. Titles = Evaluate({@Trim(@Explode(@Implode($Title; "|"); "|"))}, notedoc) Forall elename In Titles If Not Isnull(Arraygetindex(DocTitles, elename, CISPS)) Then Redim Preserve ReturnedTitles(y) Redim Preserve DesignDocs(y) ReturnedTitles(y) = elename Set DesignDocs(y) = notedoc y = y + 1 Exit Forall End If End Forall GetNextNote: nid = nc.GetNextNoteId(nid) Next If ReturnedTitles(0) = "" Then ErrMsg = "No design documents found carrying the specified names."
Exit Function End If GetDesignDocuments = True Exit Function '==================================================================== SelectDesignTypeCollection: Select Case Ucase(DesignDocType) Case "ACTIONS" nc.SelectActions = True Case "AGENTS" nc.SelectAgents = True Case "DATABASESCRIPT" nc.SelectDatabaseScript = True Case "DATACONNECTIONS" nc.SelectDataConnections = True Case "FOLDERS" nc.SelectFolders = True Case "FORMS" nc.SelectForms = True Case "FRAMESETS" nc.SelectFramesets = True Case "HELPABOUT" nc.SelectHelpAbout = True Case "HELPINDEX" nc.SelectHelpIndex = True Case "HELPUSING" nc.SelectHelpUsing = True Case "ICON" nc.SelectIcon = True Case "IMAGERESOURCES" nc.SelectImageResources = True Case "FORMULA" nc.SelectionFormula = True Case "JAVARESOURCES" nc.SelectJavaResources = True Case "MISCCODEELEMENTS" nc.SelectMiscCodeElements = True Case "MISCFORMATELEMENTS" nc.SelectMiscFormatElements = True Case "INDEXELEMENTS" nc.SelectMiscIndexElements = True Case "NAVIGATORS" nc.SelectNavigators = True Case "OUTLINES" nc.SelectOutlines = True Case "PAGES" nc.SelectPages = True Case "REPLICATIONFORMULAS" nc.SelectReplicationFormulas = True Case "SCRIPTLIBRARIES" nc.SelectScriptLibraries = True Case "SHAREDFIELDS" nc.SelectSharedFields = True Case "STYLESHEETRESOURCES" nc.SelectStyleSheetResources = True Case "SUBFORMS" nc.SelectSubforms = True Case "VIEWS" nc.SelectViews = True Case Else 'not supported NotFound = True End Select Return End Function

Do you have comments on this tip? Let us know.

Dig Deeper on Domino Resources

Start the conversation

Send me notifications when other members comment.

Please create a username to comment.




  • iSeries tutorials's tutorials provide in-depth information on the iSeries. Our iSeries tutorials address areas you need to know about...

  • V6R1 upgrade planning checklist

    When upgrading to V6R1, make sure your software will be supported, your programs will function and the correct PTFs have been ...

  • Connecting multiple iSeries systems through DDM

    Working with databases over multiple iSeries systems can be simple when remotely connecting logical partitions with distributed ...