Left (string, n) – первые n символов строки.


Right (string, n) – последние n символов.


Instr ([start,] string, substring) – ищет substring в строке, возвращает позицию.
s = "Hello LotusScript"
pos = Instr(s, "Lotus")   ' ищем "Lotus"
Messagebox pos   ' результат: 7



Mid (string, start [, length]) – подстрока "string" начиная с позиции start, длиной length.
Пример.
Print Mid$("InterTrust", 1,5) ' Выводит Inter
Print Mid$("InterTrust", 6) ' Выводит Trust

    ' ---------------- DXL: экспортим, ----------------
    Dim exporter As NotesDXLExporter
    Dim importer As NotesDXLImporter
    Dim dxl As String
    
    Set exporter = session.CreateDXLExporter()
    exporter.RichTextOption=DXL_RICHTEXTOPTION_DXL
    exporter.OmitRichtextAttachments=1
    
    dxl = exporter.Export(docR) ' получаем DXL как строку
        ' Msgbox dxl
    Call streamIn.open ("C:\XML\DXL.xml")       '   СОЗДАЛИ ФАЙЛ DXL.xml
    Call streamIn.Truncate()
    streamIn.WriteText (dxl)
    
        ' ================== DOMParser  ==================
    
    Dim domParser As NotesDOMParser
    Dim docNode As NotesDOMDocumentNode
    Dim nodelist As NotesDOMNodeList
    Dim itemNode As NotesDOMElementNode
    Dim rawNode As NotesDOMElementNode
    Dim rawData As String
    Dim i As Long
    Dim bodyCount As Integer
    Dim children As NotesDOMNode
    Print "1111111111111111111111111111"
    
    Set domParser=session.CreateDOMParser(streamIn) 
    Print "222222222222222222222"
    domParser.Process
    Print "domParser.Process"
    
    Set docNode = domParser.Document
    Call streamIn.Close
    Print "docNode"

Sub Click(Source As Button)     '  Через МИМЕ - не пашет
    On Error Goto ErrH
    Dim session As New NotesSession, ws As New NotesUIWorkspace, db As NotesDatabase, sview As NotesView, dc As NotesDocumentCollection
    Dim uidoc As NotesUIDocument, doc As NotesDocument, templdoc As NotesDocument, DocTemp As NotesDocument
    Dim picklist As Variant, mes As String
    Dim rtitem As NotesRichTextItem
    Dim Name_Stncl_List()  ' все имена вложений
    
    
    
    Set doc = ws.CurrentDocument.Document
    Set uidoc=ws.CurrentDocument
    Call uidoc.save
    
    Set rtitem = doc.GetFirstItem("attach")
    
    Dim xxxx As  Integer
    i=0
    If ( rtitem.Type = RICHTEXT ) Then 
        If Not Isempty(rtitem.EmbeddedObjects) Then  
            Forall obj In rtitem.EmbeddedObjects
                If obj.Type = EMBED_ATTACHMENT Then   ' шаг 1 имена вложений в массив
                    If obj.FileSize=0 Then
                        xxxx =     Messagebox     ({"Приложение:  } & obj.Source & { имеет размер 0 байт.} & Chr(13) & Chr(13)   & {Удалить?"}, 1 , "Удаление нулевого вложения." ) 
                        If xxxx = 1 Then
                            doc.history= Cstr(Now)   + " "+ session.CommonUserName + " удалено приложение размером 0 байт ("  + obj.Source + ") "   &Chr(13) & " "&Chr(13) &  doc.history(0)
                            Call  obj.Remove
                            doc.ReplaceItemValue({SaveOptions},{0}).SaveToDisk=False
                            Call doc.save (True,False)
                            Call uidoc.Close
                            Call ws.EditDocument(True, doc)  '  False - чтение
                            Exit Sub
                        End If
                        
                    Else
                        Redim Preserve Name_Stncl_List(i)        
                        Name_Stncl_List(i)=    obj.Source    &  {|}&   obj.Name '    в Name_Stncl_List вносим имена вложений (Source) и   альясы (Name)
                        
                        i=i+1
                    End If
                End If                
            End Forall
        End If
    End If        
    
    If i>0 Then        'есть  хоть одно вложение в поле атач
        Set DocTemp = doc.ParentDatabase.CreateDocument
        DocTemp.ReplaceItemValue  "Name_ListAttach", Name_Stncl_List   ' скрытое поле Name_ListAttach на диалог формне с  Source   |  Name
        
        If Not    ws.DialogBox("ChooseDlg",True,True,False,False,False,False,"Переименовать ",doctemp, True) Then Exit Sub
        
        nameobj2 =  doctemp.ListAttach(0)
        Print "---"
        Print nameobj2         '  псевдоним Name
    End If
    
    datapatch$ = "C:\XML\"
    If  Dir$ (datapatch$ ,16 )="" Then 
        Mkdir datapatch$
    End If
    
    i=1 
    Forall obj In rtitem.EmbeddedObjects
        If obj.Name = nameobj2  Then   ' nameobj2 - ямя выбранного вложения (псевдоним)
            Dim object3 As NotesEmbeddedObject
            Set object3 =     rtitem.GetEmbeddedObject(nameobj2)
            Print "object3.Source " object3.Source
            new_nameobj=Trim(Inputbox$("Введите новое имя приложения "  & i ,"Ввод названия приложения",Strleftback(object3.Source,".")   ))       '  строка слева от первой точки ( без расширения)
            If new_nameobj="" Then Exit Sub
            
            new_nameobj = new_nameobj & "." & Strrightback (object3.Source,".")    '   имя + расширение файла
            
            If new_nameobj<>nameobj2 Then   '  надо переименовать
                Call obj.ExtractFile( datapatch$ & nameobj2) 
                Name datapatch$ & nameobj2   As  datapatch$ & new_nameobj   '  переименовать файл nameobj на диске в new_nameobj
                
                'Call rtitem.EmbedObject ( EMBED_ATTACHMENT, "", datapatch$ & new_nameobj)    СЛЕТАЕТ ИКОНКА
                Call    GetEmbedObject ("attach",   datapatch$ & new_nameobj, doc )
                
            '    Msgbox object.Name 
            '    Call  object.Remove
                Kill  datapatch$ & new_nameobj
            End If
            
        End If
        i=i+1 
    End Forall
    
    Call doc.ComputeWithForm(False, False)
    
    Call    doc.Save(1,0)
    Call uidoc.save
    Print "11."
'    Set rtitem = doc.GetFirstItem("attach")
'    Forall obj In rtitem.EmbeddedObjects
'        Print  object.Source
'        For i = 1 To Len(object.Source)
'            ch = Mid$(object3.Source, i, 1)
'            Print "Символ=" & ch & ",  Код(Asc)=" & Asc(ch)
'        Next    
'    End Forall
    
    
    Print "Сохранили."
'    doc.history= Cstr(Now)      + " "+  session.CommonUserName + " переименовано  приложение ("  + nameobj  + ") "   &Chr(13) & " "&Chr(13) &  doc.history(0)
    
'    doc.ReplaceItemValue({SaveOptions},{0}).SaveToDisk=False
'    Call doc.save (True,False)
'    Call uidoc.Close
'    Call ws.EditDocument(True, doc)  '  False - чтение
    Exit Sub
ErrH:
    Print "Ошибка " & Error(Err) & " в строке " & Erl    
    Exit Sub
End Sub

x:=@Explode(@ProperCase(@Trim(@ThisValue)); "/");
@Prompt([OK];"x[1]";x[1] );
FIELD notesname:=x[1];
@Prompt([OK];"@Elements x[1] "; @Text(@Elements(  @Explode(@Trim(x[1])))  ) );

@If(
@Elements(  @Explode(@Trim(x[1]))  ) >1;  

@do(
y:=@Explode(@Trim(x[1]); " ");
@Prompt([OK];"y";@Implode(y) );
f:=y[1]; i:=y[2]; o:=y[3];
FIELD  FIO_1  := @Left(i;1) + "." + @Left(o;1)  + "." + f);
@ThisValue
);

x[1]

 

Sub Click(Source As Button)
    Sub Click(Source As Button)
    On Error Goto ErrH
    
    Dim ses As New NotesSession, ws As New NotesUIWorkspace
    Dim db As NotesDatabase
    Dim doc As NotesDocument
    Dim uidoc As NotesUIDocument
    
    ses.ConvertMIME = False
    Set db = ses.Currentdatabase
    Set doc = ws.CurrentDocument.Document
    Set uidoc=ws.CurrentDocument
    
    Dim body As NotesMIMEEntity, header As NotesMIMEHeader ,  child As NotesMIMEEntity  '  body  child  неисп пока
    
    Dim mime As NotesMIMEEntity
    Set mime = doc.CreateMIMEEntity("attach")
    
    Set header = mime.CreateHeader("Content-Type")    '   создали хедер штмл
    Call header.SetHeaderVal("application/vnd.ms-excel")
    Call header.SetHeaderValAndParams({multipart/alternative;charset="UTF-8"})
    
' Открываем файл
    Dim Stream As NotesStream
    Set Stream = ses.Createstream()
    Call Stream.Open("С:/Temp/excel.xlsx", "UTF-8") 
    
' Записываем содержимое в MIMEEntity
    Call mime.SetContentFromBytes(Stream, "application/vnd.ms-excel", ENC_BASE64)
    
 ' Сохраняем документ
    Call doc.Save(True, False)
    
    ses.ConvertMIME = True
    Call Stream.Close()
    
    Call uidoc.Close
    Call ws.EditDocument(True, doc)  '  False - чтение
    
    Exit Sub
ErrH:
    Print "Ошибка " & Error(Err) & " в строке " & Erl    
    Exit Sub
End Sub

Sub Click(Source As Button)
    On Error Goto ErrH
    Dim session As New NotesSession, ws As New NotesUIWorkspace, db As NotesDatabase, sview As NotesView, dc As NotesDocumentCollection
    Dim uidoc As NotesUIDocument, doc As NotesDocument, templdoc As NotesDocument, DocTemp As NotesDocument
    Dim picklist As Variant, mes As String
    Dim rtitem As NotesRichTextItem
    Dim rtitem2 As NotesRichTextItem
    Dim Name_Stncl_List()  As Variant  ' все имена вложений
    
    Set doc = ws.CurrentDocument.Document
    Set uidoc=ws.CurrentDocument
    Set rtitem = doc.GetFirstItem("attach")
    
    Dim xxxx As  Integer
    i=0
    If ( rtitem.Type = RICHTEXT ) Then 
        If Not Isempty(rtitem.EmbeddedObjects) Then  
            Forall obj In rtitem.EmbeddedObjects
                If obj.Type = EMBED_ATTACHMENT Then   ' шаг 1 имена вложений в массив
                    If obj.FileSize=0 Then
                        xxxx =     Messagebox     ({"Приложение:  } & obj.Source & { имеет размер 0 байт.} & Chr(13) & Chr(13)   & {Удалить?"}, 1 , "Удаление нулевого вложения." ) 
                        If xxxx = 1 Then
                            doc.history= Cstr(Now)   + " "+ session.CommonUserName + " удалено приложение размером 0 байт ("  + obj.Source + ") "   &Chr(13) & " "&Chr(13) &  doc.history(0)
                            Call  obj.Remove
                            doc.ReplaceItemValue({SaveOptions},{0}).SaveToDisk=False
                            Call doc.save (True,False)
                            Call uidoc.Close
                            Call ws.EditDocument(True, doc)  '  False - чтение
                            Exit Sub
                        End If
                        
                    Else
                        Redim Preserve Name_Stncl_List(i)        
                        Name_Stncl_List(i)= obj.Source ' в Name_Stncl_List вносим имена вложений
                        Print Name_Stncl_List(i)
                        i=i+1
                    End If
                End If                
            End Forall
        End If
    End If        
    
    If i>0 Then        'есть  хоть одно вложение в поле атач
        
        nameobj = ws.Prompt (PROMPT_OKCANCELLIST,     "Переименовать", "Выберите вложение",     Name_Stncl_List(0), Name_Stncl_List)
        If nameobj=False Then    Exit Sub
    End If
    
    datapatch$ = "C:\XML\"
    If  Dir$ (datapatch$ ,16 )="" Then 
        Mkdir datapatch$
    End If
    
    i=1 
    Forall obj In rtitem.EmbeddedObjects
        If obj.Source = nameobj Then   ' nameobj - ямя выбранного вложения
            
            new_nameobj=Trim(Inputbox$("Введите новое имя приложения "  & i ,"Ввод названия приложения",nameobj))        
            If new_nameobj<>nameobj Then   '  надо переименовать
                Call obj.ExtractFile( datapatch$ & nameobj) 
                Name datapatch$ & nameobj   As  datapatch$ & new_nameobj   '  переименовать файл nameobj на диске в new_nameobj
                Call rtitem.EmbedObject ( EMBED_ATTACHMENT, "", datapatch$ & new_nameobj)
                Call  obj.Remove
                Kill  datapatch$ & new_nameobj
            End If
            
        End If
        i=i+1 
    End Forall
    
    Call    doc.Save(1,0)
    Print "Сохранили."
    doc.history= Cstr(Now)      + " "+  session.CommonUserName + " переименовано  приложение ("  + nameobj  + ") "   &Chr(13) & " "&Chr(13) &  doc.history(0)
    
    doc.ReplaceItemValue({SaveOptions},{0}).SaveToDisk=False
    Call doc.save (True,False)
    Call uidoc.Close
    Call ws.EditDocument(True, doc)  '  False - чтение
    
    
    Exit Sub
    
ErrH:
    Print "Ошибка " & Error(Err) & " в строке " & Erl    
    Exit Sub
End Sub

Sub BIMOID (curdoc As NotesDocument, picklist As Variant, strukdb As NotesDatabase, user As String, db As NotesDatabase )
    On Error GoTo Errh   ' для отправк уведомлений в месседжер BIMOID серез серверный агент
    Dim item As NotesItem
    Dim strukview As NotesView
    Set strukview = strukdb.GetView("notespeople")
    
    Dim paramid As String 
    Dim agent As NotesAgent    
    Dim docRequest As NotesDocument 
    Dim docstrukt As NotesDocument
    Dim BIMOID As Variant
    
    BIMOID =""
    str1=""
    ForAll v In picklist   'Найти в БД Структура и взять chatid
        Set docstrukt =    strukview.GetDocumentByKey(v)
        BIMOID = BIMOID +  docstrukt.chatid(0) + Chr(10)
    End ForAll    
    Print "BIMOID " BIMOID
    
    mes= "Вам пришел документ " + CStr(curdoc.datereg(0)) + " №" + CStr(curdoc.fullregnom(0))   +Chr(10) + " от  "  + user
    
    Set docRequest = db.CreateDocument     
    Set item = docRequest.AppendItemValue("doc_mes", mes) 
    Set item = docRequest.AppendItemValue("FIO", BIMOID) 
    Call docRequest.save(True, False)
    
    Print "stsrt agent BIMOID"
    Set agent = db.GetAgent("BIMOID")
    paramid = docRequest.Noteid
    Print "paramid=" + paramid
    If Not agent.RunOnServer(paramid) = 0 Then
        Print "не могу запустить агент"
    End If
    Print "end agent BIMOID"

    Exit Sub
Errh:    
    Print "Ошибка BIMOID: " & Error(Err) & " в строке " & Erl
    Exit Sub
End Sub

Sub Click(Source As Button)
    Dim session As New NotesSession
    Dim ws As New notesuiworkspace
    Dim uidoc As NotesUIDocument
    Set uidoc = ws.CurrentDocument
    Dim st As String
    st=session.GetEnvironmentString( "FieldDoc")
    Print "Скопировано значение  " st
    
    Call uidoc.FieldSetText("empty",st)
    
    
End Sub

Function TranslitCyr2Lat(value As String) As String
    Const FUNC_NAME = {TranslitCyr2Lat}
    On Error GoTo errh
    
    Dim mas1 As Variant, mas2 As Variant
    Dim str1 As String, str2 As string
    
    str1 = "А;Б;В;Г;Д;Е;Ё;Ж;З;И;Й;К;Л;М;Н;О;П;Р;С;Т;У;Ф;Х;Ц;Ч;Ш;Щ;Ъ;Ы;Ь;Э;Ю;Я"
    str1 = str1 & ";" & LCase(str1)
    
    str2 = "A;B;V;G;D;E;JE;ZH;Z;I;Y;K;L;M;N;O;P;R;S;T;U;F;KH;C;CH;SH;JSH;HH;IH;JH;EH;JU;JA"
    str2 = str2 & ";" & LCase(str2)    
    
    mas1 = Split(str1, ";")
    mas2 = Split(str2, ";")
    
    TranslitCyr2Lat = Replace(FullTrim(value),mas1,mas2)

    Exit Function

errh:    
    Print {Ошибка: } & LIB_NAME & {-->} & FUNC_NAME & {, строка } & Erl & {, } & Error$
    Exit Function
End Function

Декларации:
Dim newdoc  As NotesDocument
Dim doc As NotesDocument, maindoc As NotesDocument
Dim view As notesview, uniview As NotesView

Sub Click(Source As Button)
    Dim session As New NotesSession
    Dim ws As New NotesUIWorkspace        
    Dim db As NotesDatabase, db1 As NotesDatabase, db2 As NotesDatabase
    
    On Error Goto ErrH
    Dim str1 As String
    Dim i As Integer
    i=0
    
    Set db = session.CurrentDatabase
    
    Set db1 = session.GetDatabase(db.Server,"promdoc\documents2021.nsf")
    Set db2 = session.GetDatabase(db.Server,"promdoc\documents2022.nsf")
    
    Set view = ws.CurrentView.View
    
    Set doc = view.getfirstdocument
    
    While Not doc Is Nothing
        Print doc.fullregnom(0)
        
        Set uniview = db1.GetView("unids")
        Set maindoc = uniview.GetDocumentByKey(doc.parent(0))
        If Not maindoc Is Nothing Then  Call CreateOtvet(db1)
        
        Set uniview = db2.GetView("unids")
        Set maindoc = uniview.GetDocumentByKey(doc.parent(0))
        If Not maindoc Is Nothing Then  Call CreateOtvet(db2)
        
        Set doc=view.GetNextDocument(doc)
    Wend
    Exit Sub
ErrH:
    Print "Ошибка   " & Error(Err) & " в строке " & Erl    
End Sub


Function CreateOtvet (db  As NotesDatabase)
    On Error Goto ErrH
    Print "найден док по parent!  CreateOtvet  " db.Title
    
    Set newdoc  = uniview.GetDocumentByKey(doc.id(0))
    If  newdoc Is Nothing Then ' нет копии потеряшки
        
        If    maindoc.responce(0)="" Then
            Print "главный  - создать ответ"
            Set newdoc=db.CreateDocument        
            Call doc.CopyAllItems(newdoc,1)  '   doc - в основной БД, без главного
            newdoc.UniversalID=doc.UniversalID
            Call newdoc.MakeResponse(maindoc)
            Call newdoc.ComputeWithForm(False, False)
            Print "-1----" 
            Call newdoc.Save(True,False)
            Print "создали в " db.Title
            Call doc.Remove(False)    
            Print "удалили doc" 
            Set doc = view.GetFirstDocument
        Else
            Print "в архиве ответный (maindoc) "  maindoc.fullregnom(0)
            Set maindoc  = uniview.GetDocumentByKey(maindoc.parent(0))
            If Not maindoc Is Nothing Then
                Print "в архиве нашелся главный у ответного "   maindoc.fullregnom(0)
                
                Set newdoc=db.CreateDocument        
                Call doc.CopyAllItems(newdoc,1)
                newdoc.UniversalID=doc.UniversalID
                Call newdoc.MakeResponse(maindoc)
                Call newdoc.ComputeWithForm(False, False)
                Print "-2----" 
                Call newdoc.Save(True,False)
                Print "создали в " db.Title
                Call doc.Remove(False)    
                Print "удалили doc" 
                Set doc = view.GetFirstDocument
            End If
        End If
        
    Else
        Print "ЕСТЬ ДУБЛЬ"
    End If
    
    Exit Function
ErrH:
    Print "Ошибка ф-ции  CreateOtvet   " & Error(Err) & " в строке " & Erl    
End Function

Print "Вложение сжать: " + datpatch$ & oname$ 
If (obj.FileSize > 10214400 ) Then ' БОРЯ 2024
If ws.Prompt (PROMPT_YESNO, "Внимание",    "Сжать ПДФ") = 1 Then     Call Pdf_compact (datpatch$ , oname$ )  
End If

Function Pdf_compact(datpatch As String, oname As String) As String
    On Error GoTo errh    
    Dim cmd As String
    Dim Namepdf As String
    Print "Pdf_compact старт"
    Namepdf = datpatch & oname    

    If oname = "456-output.pdf" Then
        
        cmd = datpatch & {gswin64c.exe}
        cmd = cmd & { -sDEVICE=pdfwrite}
        cmd = cmd & { -dCompatibilityLevel=1.7}
        cmd = cmd & { -dNOPAUSE}
        cmd = cmd & { -dBATCH}
        cmd = cmd & { -sColorConversionStrategy=Gray}
        cmd = cmd & { -dMonoImageResolution=60}        
        cmd = cmd & { -o"}  & datpatch & {tmpout.pdf" -f"} & datpatch & oname & {"}
        
        Print cmd
        
        Dim WShell As Variant, WshExec As Variant
        Dim OutStream As Variant, StdErr As String
        Set WShell=Nothing
        Set WshExec=Nothing
        
        Set WShell = CreateObject("WScript.Shell")
        Set WshExec = WShell.Exec(cmd)  'запускаем прогу  
        Sleep 3
        While WshExec.Status=0 'ждем закрытия проги
            Sleep 1
        Wend
        
        Set OutStream = WshExec.StdErr
        While Not OutStream.AtEndOfStream
            StdErr = StdErr & Trim(OutStream.ReadLine()) & Chr(13)
        Wend
        If Trim(StdErr)<>"" Then MsgBox StdErr
        Sleep 1
        Kill datpatch + oname
        Name datpatch + "tmpout.pdf" As datpatch + oname
        Sleep 1
    
        Print  "ЗАКРЫЛИ"
    End If
    Print "Pdf_compact END"
    Exit Function
ErrH:    
    Print "Библиотека 'MED_XML' ф-ция 'pdf_compact'. Ошибка " & Error(Err) & " в строке " & Erl    
    Exit Function
End Function