Create Database programaticaly ! plz advise

HCL Domino Domino Forum
1

Dear Friends,

In my application i want to create database programiticaly.

I want to create copy of one database (for archive purpose) and copy all document in it on monthly basis.Actually,I have to create archive of the perticuler database on monthly basis ( for each month seperate database file ie nsf),that thing i have to do manualy,but now i want to write an agent who create a .nsf file and copy monthly document in it.

my question is,can i create a .nsf file using lotus script?

if yes ,then how?

What would be the way ,plz suggest and give me the code if you have .

Thanks and regards

Anand

2

Subject: Create Database programaticaly !!! plz advise

Depending on if you want a replica or a db copy, you can use this from the notes designer help file:

Dim session As New NotesSession

Dim db As NotesDatabase

Dim replica As NotesDatabase

Set db = session.CurrentDatabase 'you might need to change this depending on where your agent is running

Set replica = db.CreateReplica( “Jakarta”, “sales.nsf” )

3

Subject: Create Database programaticaly !!! plz advise

I would suggest you to create a Profile document that contains the details for the archive Db like:Archive Db Server

Archive Db Path & Name

Archive Db Title

Then can use some code like:

Dim S As New NotesSession

Dim LocalDb As NotesDatabase

Dim profdoc As NotesDocument

Dim ArchiveDbServer As String

Dim ArchiveDbPath As String

Dim ArchiveDbTitle As String

Set LocalDb=S.CurrentDatabase

Set profdoc=LocalDb.GetProfileDocument(“ProfileDoc”)

ArchiveDbServer=profdoc.ArchiveDbServer(0)

ArchiveDbPath=profdoc.ArchiveDbPath(0)

ArchiveDbTitle=profdoc.ArchiveDbTitle(0)

Dim ArchiveDb As New NotesDatabase(ArchiveDbServer,ArchiveDbPath)

If ArchiveDb.IsOpen Then  

	Print "Got the handle to the Archive Database."

Else

	If Not(ArchiveDbServer="") Then

		If Messagebox("The Database mentioned in the Archive Settings could not be opened, do you want to create a new Archive Database at the location mentioned in the Archive Settings?For creating the new Database, you must have access to create a Database at the Server Mentioned.",4 + 32,"Archive Confirmation") = 7 Then	

			Exit Sub

		End If

	End If	

	Print "Creating the new Archive Database."

	Set ArchiveDb=LocalDb.CreateCopy(ArchiveDbServer,ArchiveDbPath,False)	

End If

ArchiveDb.Title =ArchiveDbTitle

Also, keep in mind that after creating the copy of the Db, disable/delete all the scheduled agents from the new copy and also modify the acl for the archive db.This also could be done using the lotus script.

For deleting the agents, code can be as:

Forall a In ArchiveDb.Agents

If Not(a.Name="x1qz") Then

	Call a.Remove()

End If

End Forall

And, for modifying the acl, use:

Dim acllist As NotesACL

Dim aclentry As NotesACLEntry 

Set acllist=ArchiveDb.ACL 

Set aclentry=acllist.GetFirstEntry()

While Not(aclentry Is Nothing)

	aclentry.CanCreateDocuments=False

	Set aclentry=acllist.GetnextEntry(aclentry)

Wend

Call acllist.Save()
4

Subject: working example – Create Database programaticaly !!! plz advise

Option PublicOption Explicit

Dim curDB As NotesDatabase

Dim readDB As NotesDatabase

Dim newDB As NotesDatabase, newDBName As String

Dim dbList List As String

Dim FilePath As String

Sub Initialize

' this agent makes local replicas of databases on a scheduled basis

' run on server where we have lotsa space

' the extension of the new file has a timestamp after ".NSF" -- Domino will ignore it

%REM

This agent successfully makes replica copies of databases, putting them in a directory outside the DATA directory.

Unfortunately, the indexer updates all the views one time. It may time-out when copying very large databases.

09/15/2002 02:37:51 AM AMgr: Start executing agent ‘Duplicator’ in ‘Duplicator.nsf’ by Executive ‘2’

…

%END REM

Dim sess As New NotesSession



On Error Goto ProcessError



Set sess = New NotesSession

Set curDB = sess.CurrentDatabase



' --- put as many list entries here as you want to have databases copied ---

dbList( "names" ) = "names.nsf"

’ x dbList( “tel” ) = “telephone.nsf”

’ x dbList( “disc” ) = “discussion.nsf”

FilePath = "C:\DBCopies\"  '  copy to this subdirectory



Forall dbName In dbList

	

	Set readDB = New NotesDatabase( curDB.Server, dbName )

	If readDB Is Nothing Then Error 999, "cannot open source database " & dbName ' raise an error

	

	newDBName = FilePath & dbName & "_" & GetTimeStamp   ' fullpathname of backup file

	Print "  " & dbName & " being copied to " & newDBName

	Set newDB = readDB.CreateReplica( "", newDBName )  ' create new local replica for backup

	Print newDBName & " copy done"

	

	Call SendMail( newDBName )

	

End Forall



Exit Sub

ProcessError:

Print 	"Error: " & Error$ & " err:" & Err() & " line:" & Erl()

Close

Beep

Exit Sub

End Sub

Function GetTimeStamp As String

' this function returns a time stamp in the following format:

'   "12311259"   if   now is  Dec. 31, 12:59



Dim sMo As String, sDa As String, sHo As String, sMi As String

Dim dNow As Variant



On Error Goto SubError



dNow = Now()



sMo = Month( dNow )

If Len( sMo ) = 1 Then sMo = "0" & sMo



sDa = Day( dNow )

If Len( sDa ) = 1 Then sDa = "0" & sDa



sHo = Hour( dNow )

If Len( sHo ) = 1 Then sHo = "0" & sHo



sMi = Minute( dNow )

If Len( sMi ) = 1 Then sMi = "0" & sMi



GetTimeStamp = sMo & sDa & sHo & sMi



Exit Function

SubError:

Print 	"GetTimeStamp  Error: " & Error$ & " err:" & Err() & " line:" & Erl()

Close

Beep

End  ' stop with no return

End Function

Sub SendMail( sFileName As String )

Dim emailDoc As NotesDocument



On Error Goto SubError	



Dim sAddressees(1) As String

sAddressees(0) = "somename1"

sAddressees(1) = "Doug Jamieson"



Set emailDoc = curDB.CreateDocument

eMailDoc.Form = "Memo"

eMailDoc.Principal = "Duplicator Agent"

eMailDoc.ReplyTo = eMailDoc.Principal(0)

emailDoc.Subject = "notification of new replica on " & curDB.Server

eMailDoc.Body = "A new replica (" & sFileName & ") was created." & Chr(10) & Chr(10) _

& "This agent was run from:" & Chr(10) _

& "    " & curDB.Filepath & " " & curDB.Title



Call emailDoc.Send( False, sAddressees )



Exit Sub

SubError:

Print "SendMail "  & Error$ & " err:" & Err() & " line:" & Erl()

Close

Beep

End  '  stop -- don't just exit the subroutine

End Sub

5

Subject: Thank you all

thank you all !!

For your great advise.your advise will definatly help me.

Once again thank you verry much…

“Have a Nice day and weekend”

thanks and regards

Anand