(declaratons)
Private curr_ses As NotesSession
Private curr_db As NotesDatabase
Private LIST_SUBFORM List As Boolean
Private LIST_EMBVIEW List As String
Sub Initialize
Dim s As New NotesSession
'SB которые надо обновить
LIST_SUBFORM("<имя подформы>") = True
'Вьюхи которые надо обновить
LIST_EMBVIEW("<имя вьюхи>") = "имя базы"
'Определяем БД
Set curr_ses = s
Set curr_db = s.CurrentDatabase
'Запускаем обновление
Call MAUX_rebuildView()
End Sub
Sub MAUX_rebuildView
''подфункция для MakeEmbView
On Error Goto ERRORSYSTEM
' с помощью этого класса получим коллекцию подформ в текущей БД
Dim subformCollection As NotesNoteCollection
' с помощью этих классов выполним конвейерную обработку DXL
Dim exporter As NotesDXLExporter
Dim xml As NotesDOMParser
Dim importer As NotesDXLImporter
' создаем экземпляр NotesNoteCollection в текущей базе
Set subformCollection = curr_db.CreateNoteCollection(False)
' отбираем в коллекцию только подформы
Forall x In LIST_SUBFORM
Call subformCollection.Add( curr_db.GetForm(Listtag(x)) )
End Forall
' если вдруг подформ в БД не оказалось - выходим
If subformCollection.Count = 0 Then Exit Sub
' сначала объявляем парсер, чтобы при объявлении экспортера сразу его указать в качестве
' приёмника
Set xml = curr_ses.CreateDOMParser
' после того, как DXL будет отпарсен, приступаем к поиску и замене нужного нам
' параметра
On Event PostDOMParse From xml Call MAUX_postParse
' создаем экспортер, на входе - коллекция подформ, на выходе - парсер
Set exporter = curr_ses.CreateDXLExporter(subformCollection,xml)
' создаем импортер, на входе - парсер, на выходе - текущая база
Set importer = curr_ses.CreateDXLImporter(xml, curr_db)
' при импорте элементов дизайна - заменять уже существующие, а если не существует -
' игнорировать
importer.DesignImportOption = DXLIMPORTOPTION_REPLACE_ELSE_IGNORE
' поехали!
Call exporter.Process
Exit Sub
ERRORSYSTEM: 'ОБРАБОТЧИК СИСТЕМНЫХ ОШИБОК
Error Err,Error +Chr(10)+"<br>, "+Cstr(Getthreadinfo(1))+ ", строка: "+Cstr(Erl)
Exit Sub
End Sub
Sub MAUX_postParse(xml As NotesDOMParser)
''подфункция для MakeEmbView
On Error Goto ERRORSYSTEM
' корень экспортированного DXL
Dim root As NotesDOMDocumentNode
' ориентироваться будем на несколько подформ
Dim subFormNodeList As NotesDOMNodeList
Dim subFormNode As NotesDOMElementNode
' этот элемент будет представлять внедренное представление
Dim embViewNodeList As NotesDOMNodeList
Dim embViewNode As NotesDOMElementNode
Dim i As Integer
Dim EMBVIEW_NAME As String
Dim DB_EMBVIEW As NotesDatabase
Dim SUBFORM_NAME As String
Dim zz_db_name As String
Dim t_var As Variant
' получаем корень
Set root=xml.Document
' и ищем все подформы
Set subFormNodeList=root.GetElementsByTagName("subform")
For i=1 To subFormNodeList.NumberOfEntries
' перебираем по очереди каждую
Set subFormNode = subFormNodeList.GetItem(i)
' ищем подформы с EMB и обновляем database
Set embViewNodeList = subFormNode.getElementsByTagName("embeddedview")
If embViewNodeList.NumberOfEntries >0 Then
Set embViewNode = embViewNodeList.GetItem(1)
EMBVIEW_NAME = embViewNode.GetAttribute("name")
If Iselement(LIST_EMBVIEW(EMBVIEW_NAME)) Then
Set DB_EMBVIEW = New NotesDatabase(<сервер>, LIST_EMBVIEW(EMBVIEW_NAME))
Call embViewNode.SetAttribute("database" , DB_EMBVIEW.ReplicaID)
Print "Обновлено EMB VIEW с именем " + EMBVIEW_NAME
End If
End If
Next
'парсер не умеет автоматически подавать на выход, поэтому нужно его об этом попросить
Call xml.Serialize
Exit Sub
ERRORSYSTEM: 'ОБРАБОТЧИК СИСТЕМНЫХ ОШИБОК
Error Err,Error +Chr(10)+"<br>, "+Cstr(Getthreadinfo(1))+ ", строка: "+Cstr(Erl)
Exit Sub
End Sub