Sub InsDesignHP
Dim s As New NotesSession
Dim destdb As NotesDatabase
Dim sourcedb As NotesDatabase
Dim NC As NotesNoteCollection
Dim curdisdoc As NotesDocument
Dim destdisdoc As NotesDocument
Dim tempdisdoc As NotesDocument
Dim noteid As String
Dim tempUNID As String
Dim curDT As New NotesDateTime ("")
Dim destDt As New NotesDateTime ("")
On Error Resume Next
Set destdb = s.Getdatabase("", "bookmark.nsf", False) ' получаем базу пользователя
Set sourcedb = s.GetDatabase("ezop","hp.nsf") ' получаем нашу базу с исходниками страницы
If sourcedb Is Nothing Or destdb Is Nothing Then
' Msgbox "Нет источника"
Exit Sub
End If
%REM
'******************************************
'* Удаляем старые фреймы и страницы - CorpWP
Set nc = destdb.CreateNoteCollection(False)
' Выбираем в базе только дизайн элементы необходимого нам вида
nc.SelectFrameSets = True
nc.SelectPages = True
Call nc.BuildCollection
' и перекладываем то что навыбирали в базу пользователю
noteid = nc.GetFirstNoteId
Do Until noteid = ""
Set curdisdoc = destdb.GetDocumentByID(noteid)
If curdisdoc.Getitemvalue("$TITLE")(0) = "CorpWP" Then Call curdisdoc.Remove(True)
noteid = nc.GetNextNoteId(noteid)
Loop
'*******************************************
%END REM
Set nc = sourcedb.CreateNoteCollection(False)
' Выбираем в базе только дизайн элементы необходимого нам вида
nc.SelectFrameSets = True
nc.SelectPages = True
nc.Selectforms = True
nc.SelectImageResources = True
Call nc.BuildCollection
' и перекладываем то что навыбирали в базу пользователю
noteid = nc.GetFirstNoteId
Do Until noteid = ""
Set curdisdoc = sourcedb.GetDocumentByID(noteid)
Set destdisdoc = destdb.GetDocumentByUNID(curdisdoc.UniversalID)
If (destdisdoc Is Nothing) Then
Set destdisdoc= curdisdoc.CopyToDatabase(destdb)
tempUNID = destdisdoc.UniversalID
destdisdoc.UniversalID=curdisdoc.UniversalID
Call destdisdoc.Save(True,False)
Set tempdisdoc = destdb.GetDocumentByUNID(tempUNID)
Call tempdisdoc.Remove(true)
Else
curDT.LSLocalTime = curdisdoc.LastModified
destDT.LSLocalTime=destdisdoc.LastModified
If curDT.TimeDifference(destDT)>0 Then
' Msgbox curDT.TimeDifference(destDT)
Call destdisdoc.Remove(True)
Set destdisdoc= curdisdoc.CopyToDatabase(destdb)
tempUNID = destdisdoc.UniversalID
destdisdoc.UniversalID=curdisdoc.UniversalID
Call destdisdoc.Save(True,False)
Set tempdisdoc = destdb.GetDocumentByUNID(tempUNID)
Call tempdisdoc.Remove(True)
End If
End If
' Msgbox curdisdoc.UniversalID + "|" + destdisdoc.UniversalID
noteid = nc.GetNextNoteId(noteid)
Set destdisdoc=Nothing
Set curdisdoc=Nothing
Loop
End Sub
Sub ChangeHP
Dim s As New NotesSession
Dim destdb As NotesDatabase
Dim sourcedb As NotesDatabase
Dim prof As NotesDocument
Dim curdoc As NotesDocument
Dim newdoc As NotesDocument
Dim curHP As String
Dim newHP As String
Dim NC As NotesNoteCollection
Dim curdisdoc As NotesDocument
Dim destdisdoc As NotesDocument
Dim noteid As String
Dim vie As NotesView
On Error Resume Next
Set destdb = s.Getdatabase("", "bookmark.nsf", False) ' получаем базу пользователя
' а это юнид нашей настройки
newHP = "E2113B72532D23B846257D69001985AD"
' берем профиль настроек текущей страницы
Set prof = destdb.Getprofiledocument("currentlayout")
' смотрим какая страница стоит
curHP = prof.GetItemValue("CurrentLayoutKey")(0)
Set curdoc = destdb.Getdocumentbyunid(curHP)
' ечли уже нужная то не дергаемся
If curdoc.ourcorp(0)=newHP Then Exit Sub
Set sourcedb = s.GetDatabase("ezop","hp.nsf") ' получаем нашу базу с исходниками страницы
If sourcedb Is Nothing Then
' Msgbox "Нет источника"
Exit Sub
End If
Set vie = sourcedb.Getview("(Layouts)")
Set newdoc = vie.Getfirstdocument()
Set newdoc = newdoc.Copytodatabase(destdb)
' ну и собственно сносим текущую настройку, а нашей присваиваем ид стоявшей..
' не знаю почему, но просто перепрописывать в профиль новый ИД грозит траблами((
Call curdoc.Copytodatabase(destdb)
Call curdoc.Remove(True)
newdoc.UniversalID = curHP
Call newdoc.ReplaceItemValue("ourcorp",newHP)
Call newdoc.Save (True,False)
End Sub
