Partial replace design

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.

This was first published in January 2004

There are Comments. Add yours.

TIP: Want to include a code block in your comment? Use <pre> or <code> tags around the desired text. Ex: <code>insert code</code>

REGISTER or login:

Forgot Password?
By submitting you agree to receive email from TechTarget and its partners. If you reside outside of the United States, you consent to having your personal data transferred to and processed in the United States. Privacy
Sort by: OldestNewest

Forgot Password?

No problem! Submit your e-mail address below. We'll send you an email containing your password.

Your password has been sent to:

Disclaimer: Our Tips Exchange is a forum for you to share technical advice and expertise with your peers and to learn from other enterprise IT professionals. TechTarget provides the infrastructure to facilitate this sharing of information. However, we cannot guarantee the accuracy or validity of the material submitted. You agree that your use of the Ask The Expert services and your reliance on any questions, answers, information or other materials received through this Web site is at your own risk.