Re: Полезные Lotus скрипты.
Lotus и удаление пустых элементов массива
values - массив с пустыми элементами
vals=Fulltrim (values) - будет без пустышек.
Компьютерный форум для чайников и IT специалистов. Советы и рекомендации.
Форум компьютерной помощи → Lotus/Domino → Полезные Lotus скрипты.
Чтобы отправить ответ, вы должны войти или зарегистрироваться
Lotus и удаление пустых элементов массива
values - массив с пустыми элементами
vals=Fulltrim (values) - будет без пустышек.
Логирование изменений содержимого поля после подписи:
В кнопке подписать:
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Диалоговое окно для сохранения файла на диск:
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Получение имени ПК и юзера из винды.
Dim WshShell As Variant
Set WshShell = CreateObject("WScript.Shell")
xxx=WshShell.ExpandEnvironmentStrings( "%COMPUTERNAME%" )
yyy=wshShell.ExpandEnvironmentStrings( "%USERNAME%" )
Print xxx & "//" & yyyРазблокировать все документы в базе. Настраиваем агенту ночное расписание.
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Код для занесения или добавления в поле 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Правильная проверка существования поля item и его копирования:
Set item=CurDoc.GetFirstItem( "СОДЕРЖАНИЕ_" )
If Not item Is Nothing Then Call docR.CopyItem (item,"СОДЕРЖАНИЕ_")Еще вариант
If doc.hasitem("PSComment") ThenОказывается одной строкой можно и создать/заменить значение поля и дать ему свойства автора/ридера.
Dim newDocResp As NotesDocument
newDocResp.Replaceitemvalue("Author", "*").Isauthors = True
newDocResp.Replaceitemvalue("Reader", "*").Isreaders = True
Экранирование кавычек в запросе формулы в LotusScript.
masin(i) = Replace(masin(i) , {"}, {\"})В LotusScript при работе с Db.Search и использованием формул необходимо экранировать кавычки правильно, так как строки в LotusScript обрамляются двойными кавычками, а формула также может содержать строки в кавычках.
пример для запроса formula = { @lowercase("ПАРКАНСКАЯ ГРУЭС")}
@Contains (@lowercase(t2); @lowercase("\"ПАРКАНСКАЯ ГРУЭС\""))
Нужно поле "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:33Lotus 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);
""
)Выгрузка базы - форм, видов и агентов в ДХЛ (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Чтобы отправить ответ, вы должны войти или зарегистрироваться
Форум компьютерной помощи → Lotus/Domino → Полезные Lotus скрипты.
Форум работает на PunBB, при поддержке Informer Technologies, Inc