Sub Click(Source As Button)
    
    On Error Goto ErrorHandler
    
    Dim session As New NotesSession
    Dim db As NotesDatabase
    Dim nc As NotesNoteCollection
    Dim exporter As NotesDXLExporter
    Dim stream As NotesStream
    
    Dim fileName As String
    Dim msg As String
    
    ' Текущая база
    Set db = session.CurrentDatabase
    
    ' Папка должна существовать
    fileName = "C:\XML\Adress_design.dxl"
    
    ' Создаём коллекцию элементов
    Set nc = db.CreateNoteCollection(False)
    
    ' Выбираем только формы, виды и агенты
    nc.SelectForms = True
    nc.SelectViews = True
    nc.SelectAgents = True
    
    
    ' Формируем коллекцию
    Call nc.BuildCollection
    
    ' Создаём файл
    Set stream = session.CreateStream
    
    If Not stream.Open(fileName, "UTF-8") Then
        Messagebox "Не удалось создать файл:" & Chr(10) & _
        fileName,, "Ошибка"
        Exit Sub
    End If
    
    Call stream.Truncate
    
    ' Экспортируем в DXL
    Set exporter = session.CreateDXLExporter
    
    Call exporter.SetInput(nc)
    Call exporter.SetOutput(stream)
    
    Call exporter.Process
    
    Call stream.Close
    
    msg = "ЭКСПОРТ ЗАВЕРШЁН!" & Chr(10) & Chr(10)
    msg = msg & "База: " & db.FileName & Chr(10)
    msg = msg & "Количество элементов: " & _
    Cstr(nc.Count) & Chr(10) & Chr(10)
    msg = msg & "Файл: " & fileName
    
    If exporter.Log <> "" Then
        msg = msg & Chr(10) & Chr(10) & exporter.Log
    End If
    
    Messagebox msg,, "Экспорт архитектуры"
    
    Exit Sub
    
ErrorHandler:
    
    On Error Resume Next
    Call stream.Close
    
    Messagebox "Ошибка № " & Cstr(Err) & Chr(10) & _
    Error$,, "Экспорт архитектуры"
    
End Sub

@If (database="promdoc\\documents.nsf";"Документы";database="promdoc\\documents2016.nsf";"Архив 2016";database="promdoc\\documents2017.nsf";"Архив 2017";database="promdoc\\documents2018.nsf";"Архив 2018";database="promdoc\\documents2019.nsf";"Архив 2019";database="promdoc\\documents2020.nsf";"Архив 2020";database="promdoc\\documents2021.nsf";"Архив 2021";database="promdoc\\documents2022.nsf";"Архив 2022";database="promdoc\\documents2023.nsf";"Архив 2023";"")

@If(
 @Contains(database; "documents.nsf");
 "Документы";
 @Contains(database; "documents");
 "Архив " + @Middle(database; @Length(database) - 8; 4);
 ""
)

Dim ndt As NotesDateTime
Set ndt  = New NotesDateTime(docx.datereg(0))    
xlWbk.ActiveSheet.Cells(row, 3)= ndt.DateOnly
xlWbk.ActiveSheet.Cells(row, 4)= Format$(Cdat(ndt.LSLocalTime), "hh:nn")    

    Dim fname As String
    fname = "ВНУТР_"   & Format(Now,"yyyy_mm_dd_hh")  & ".xlsx"
    Set xl=CreateObject("Excel.Application")
Set xlWbk=xl.Workbooks.Add
...

    xl.Visible=True
    Call xlWbk.SaveAs(fname)

arr =     Split( Cstr(docx.datereg(0)), " ")
Print   arr(0)   " - "   arr(1) 
xlWbk.ActiveSheet.Cells(row, 3)=  arr(0)     'Left$(Cstr(docx.datereg(0)), 10)   '02.03.2026   DateOnly
xlWbk.ActiveSheet.Cells(row, 4)=          arr(1)            'Right$(Cstr(docx.datereg(0)), 8)    '12:13:33

masin(i) = Replace(masin(i) ,  {"}, {\"})

Set item=CurDoc.GetFirstItem( "СОДЕРЖАНИЕ_" )
If Not item Is  Nothing  Then Call docR.CopyItem (item,"СОДЕРЖАНИЕ_")

If doc.hasitem("PSComment") Then

Sub Click(Source As Button)
    
    Dim session As New NotesSession
    Dim uiworkspace As New NotesUIWorkspace    
    Dim doc As NotesDocument
    Set doc = uiworkspace.CurrentDocument.Document
    
    Dim item As NotesItem
    'Set item = doc.GetFirstItem("$UpdatedBy") 'в $UpdatedBy в лотусе ничего нельзя изменять
    Set item = doc.GetFirstItem("Reader")    
    Call item.AppendToTextList( "CN=Елена Владимировна /O=inf" )
    
    
    Forall  xxx  In item.Values
        Msgbox xxx
    End Forall
    
    Call doc.Save ( True, False )
    
    Msgbox "Всё ок!"
End Sub

Sub Initialize
    Dim session As New NotesSession
    Dim Okno As NotesDatabase
    Set Okno = session.CurrentDatabase
    
    If Not Okno.Isopen Then
        Exit Sub    ' Нет доступа к БД !!!!!!
    End If
    
    Dim Doccount As NotesDocument  '  документ
    
    Dim dcOko As NotesDocumentCollection 'коллекция доков базы 
    Set dcOko = Okno.AllDocuments 'коллекционируем все документы
    If   (dcOko.Count =0) Then  Exit Sub
    
    For m=1  To dcOko.Count
        Set Doccount = dcOko.GetNthDocument(m)
        
        If     (Doccount.IsValid )    Then
            Call Doccount.RemoveItem("$Writers")            
            Call Doccount.RemoveItem("$WritersDate")
            Call Doccount.Save(True, False, True)
        End If
    Next
End Sub

Dim WshShell As Variant
Set WshShell = CreateObject("WScript.Shell")
xxx=WshShell.ExpandEnvironmentStrings( "%COMPUTERNAME%" )
yyy=wshShell.ExpandEnvironmentStrings( "%USERNAME%" )
Print xxx & "//" & yyy

Sub Click(Source As Button)
    If  Dir$ ("C:\XML",16) =""  Then
        Mkdir "C:\XML" 
    End If
    zag$ = "Имя файла"
    Dim workspace As New NotesUIWorkspace
    filenames = workspace.SaveFileDialog(False,"Куда ",,"C:\XML\",zag$)
End Sub

Call CurDoc.ReplaceItemValue("Flag_RW","1")

Sub Onchange(Source As Field)
    
    Dim session As New NotesSession
    Dim uiworkspace As New NotesUIWorkspace    
    Dim doc As NotesDocument
    Dim item As NotesItem
    Set doc = uiworkspace.CurrentDocument.Document
    Set item = doc.GetFirstItem("СОДЕРЖАНИЕ")
    If doc.Flag_RW(0)="1" Then
        
        Dim Name_ As New NotesName(session.UserName)
        UsnameCanon$= Name_.common    
        doc.log_sod =  Arrayappend (doc.log_sod, "Содержание изменил: " & UsnameCanon$ & ". Дата: " & Date$ )        
    End If
    
End Sub

str1  = Cstr(Now) + " нвоый текст, который заносится в историю"
    
    Dim RTItm As NotesRichTextItem
    Set RTItm=CurDoc.getFirstItem("ИСТОРИЯ")
    Dim TmpRTItem As NotesRichTextItem  
    
    If CurDoc.HasItem("TmpRTF") Then 'если  есть временное поле - стерли
        Set TmpRTItem=CurDoc.GetFirstItem("TmpRTF")
        Call TmpRTItem.Remove()
    End If
    
    Set TmpRTItem= CurDoc.CreateRichTextItem("TmpRTF") ' создали поле TmpRTF
    Call TmpRTItem.Appendtext(str1) 
    Call TmpRTItem.Addnewline(1,True)
    Call TmpRTItem.Appendrtitem(RTItm) ' добавили поле история    
    
    Call RTItm.Remove()
    
    Set NewRTItem= CurDoc.CreateRichTextItem("ИСТОРИЯ")
    Call NewRTItem.Appendrtitem(TmpRTItem)
    Call TmpRTItem.Remove()

Dim uiworkspace As New NotesUIWorkspace        
    Dim histold As String, str1 As String
    Dim doc As NotesDocument
    Dim uidoc As NotesUIDocument 
    Set uidoc =uiworkspace.CurrentDocument
    Set doc =uiworkspace.CurrentDocument.Document
    doc.какое-то поле=""
    
    str1  = Cstr(Now) + " текст для истории"+" "&Chr(10)
    
    histold= uidoc.FieldGetText( "ИСТОРИЯ" )
    
    Call uidoc.FieldClear( "ИСТОРИЯ" )
    Call uidoc.FieldAppendText( "ИСТОРИЯ", str1)
    Call uidoc.FieldAppendText( "ИСТОРИЯ", histold)
    Call uidoc.Save()

Dim item As NotesItem
    xx=0
    Set item = CurDoc.GetFirstItem( "РАССМАТРИВАЕТ_ДОКУМЕНТ" )
    Forall v In item.Values
        xx=xx+1 
    End Forall
    If xx>1 Then Messagebox("Док. рассматривает несколько человек!") : Exit Sub

Sub Postopen(Source As Notesuidocument)
    Dim Session As New NotesSession
    Dim ws As New NotesUIWorkspace
    Dim item As NotesItem    
    user = session.CommonUserName
    Dim doc As NotesDocument
    flag="1"
    Set doc = ws.currentdocument.Document
    Set item = doc.GetFirstItem( "addauthors" )    
    Forall v In item.Values
        If     user = v Then 
            Print "автор"
            flag="0"
        End If            
    End Forall
    If flag="0" Then 
        source.EditMode=True
    End If
End Sub