26

Re: Полезные Lotus скрипты.

Lotus и удаление пустых элементов массива
values - массив с пустыми элементами
vals=Fulltrim (values) - будет без пустышек.

Поделиться

27

Re: Полезные Lotus скрипты.

Логирование изменений содержимого поля после подписи:

В кнопке подписать:

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

Поделиться

28

Re: Полезные Lotus скрипты.

Диалоговое окно для сохранения файла на диск:

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

Поделиться

29

Re: Полезные Lotus скрипты.

Получение имени ПК и юзера из винды.

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

Поделиться

30

Re: Полезные Lotus скрипты.

Разблокировать все документы в базе. Настраиваем агенту ночное расписание.

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

Поделиться

31

Re: Полезные Lotus скрипты.

Код для занесения или добавления в поле Reader имени человека.

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

Поделиться

32

Re: Полезные Lotus скрипты.

Правильная проверка существования поля item и его копирования:

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

Еще вариант

If doc.hasitem("PSComment") Then

Поделиться

33

Re: Полезные Lotus скрипты.

Оказывается одной строкой можно и создать/заменить значение поля и дать ему свойства автора/ридера.

Dim newDocResp As NotesDocument
newDocResp.Replaceitemvalue("Author", "*").Isauthors = True
newDocResp.Replaceitemvalue("Reader", "*").Isreaders = True

Поделиться

34

Re: Полезные Lotus скрипты.

Экранирование кавычек в запросе формулы в   LotusScript.

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

В LotusScript при работе с Db.Search и использованием формул необходимо экранировать кавычки правильно, так как строки в LotusScript обрамляются двойными кавычками, а формула также может содержать строки в кавычках.

пример для запроса formula    =  {    @lowercase("ПАРКАНСКАЯ ГРУЭС")}

   @Contains (@lowercase(t2); @lowercase("\"ПАРКАНСКАЯ ГРУЭС\""))

Поделиться

35

Re: Полезные Lotus скрипты.

Нужно поле "datereg" типа : Time/Date   разделить на два поля  отчете - дата и отдельно часы/минуты.
Колонка 3 - год/месяц/число
Колонка 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(1) .

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

Поделиться

36

Re: Полезные Lotus скрипты.

Lotus Notes формулу можно сделать универсальной, чтобы не перечислять вручную каждую базу documents2016.nsf, documents2017.nsf и т. д.

@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);
 ""
)

Поделиться

37

Re: Полезные Lotus скрипты.

Выгрузка базы - форм, видов и агентов в ДХЛ (DXL) формат.

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

Поделиться