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