待办模板库拷贝

%REM
Function getTaskDb
Description: 获取个人代办库，没有则根据模版创建
%END REM
Function GetTaskDb(dbName As String,userName As String)
On Error GoTo erroHander
Dim tempTaskDb As NotesDatabase
Dim taskDb As NotesDatabase
Dim taskPath As String
Dim acl As NotesACL
Dim aclentry As NotesACLEntry
Dim taskAcl As NotesACL
Dim taskAclEntry As NotesACLEntry
Dim roles As Variant
Set tempTaskDb=session.Getdatabase(cdb.server, "Tasks\tasktemplate.nsf", false)

taskPath="Tasks\"+dbName+".nsf"
Set taskDb=session.Getdatabase(cdb.server, taskPath, False)
If taskDb Is Nothing Then
Set taskDb=tempTaskDb.Createfromtemplate(cdb.server, taskPath, true)
taskDb.Title=dbName

Set taskAcl=taskDb.Acl
Set acl = tempTaskDb.ACL
Set aclentry = acl.GetFirstEntry
While not aclentry Is Nothing 
Call taskDb.GrantAccess(aclentry.name,aclentry.level)
Set taskAclEntry=taskAcl.Getentry(aclentry.name)
taskAclEntry.UserType=aclentry.UserType
ForAll r In aclentry.Roles
If r<>""Then
taskAclEntry.Enablerole(r)
End If
End ForAll
Set aclentry=acl.GetNextEntry(aclentry)
Wend
Call taskDb.GrantAccess(userName,3)
Set taskAclEntry=taskAcl.Getentry(userName)
taskAclEntry.UserType=1
Call taskAcl.Save()

End If
If Not taskDb.IsFTIndexed Then
Call taskDb.CreateFTIndex(FTINDEX_ALL_BREAKS + FTINDEX_CASE_SENSITIVE, False)
Else
Call taskDb.Updateftindex(True)
End If
Set GetTaskDb=taskDb
Exit Function
erroHander:
MsgBox "获取个人代办库:GetTaskDb,line:" & CStr(Erl) & ",error:" & Error
End Function