Вариант с УИ.

    mes2=sdate(0)+"   документ отправил для подписи "&Chr(10)+user+" на " + mes3+" "&Chr(10)+" с комментарием: " + curdoc.komment(0)&Chr(10)+" "&Chr(10)
'+++++++++++++++++++++++++++++++   
    Call uidoc.FieldSetText("tmpadmh",uidoc.FieldGetText("adminhistory"))
    Call uidoc.FieldClear("adminhistory")
    Call uidoc.FieldSetText("adminhistory",mes2)
    Call uidoc.FieldAppendText("adminhistory",uidoc.FieldGetText("tmpadmh"))
    Call uidoc.FieldClear("tmpadmh")
    Call uidoc.Refresh(True)
'+++++++++++++++++++++++++++++++   
    mes=curdoc.dohistory(0)
    curdoc.dohistory=mes2+mes

вариант 2
formul$=  "В " + Cstr(Now) + " документ XML сформирован (" + session.CommonUserName + ")." &Chr(13)+" "&Chr(13)   
    'Msgbox formul$
  doc.ИСТОРИЯ =  formul$  + doc.ИСТОРИЯ

==================================ОПИСАНИЕ Public методов и свойств класса Verify_Signed_XML============================================   
Public
    Property Get GetListFIOTeg             As Variant     'получаем массив данных ФИО из тега (если нет ФИО - возвращается NULL)
    Property Get GetListFIOEP             As Variant    'получаем массив данных ФИО из ЭП (если нет ФИО - возвращается NULL)
    Property Get GetListFIOPodp         As Variant    'получаем массив данных ФИО из базы подписантов (если нет ФИО - возвращается NULL)
    Property Get GetNameOrg             As String    'получаем наименование ведомства отославшей документ
    Property Get GetKodMedOrg             As String    'получаем код организации отославшей документ (если из подведа - то к примеру 7.501)
    Property Get GetCountListFIOTeg     As Integer    'получаем кол-во ФИО из тега
    Property Get GetCountListFIOEP         As Integer    'получаем кол-во ФИО из ЭП
    Property Get GetCountListFIOPodp    As Integer    'получаем кол-во ФИО из базы подписанты по ведомству отославшей документ
    Property Get isError                 As Boolean    'была/не было ошибки True/False
    Property Get GetErrorText             As String   'получаем текст ошибки
   
    Property Set SetPathCriptoGSS     As String        'передаем путь к ConsoleCriptoGSS
    Property Set SetPathXML         As String        'передаем путь к проверяемому файлу
    Property Set SetServerDBSigned     As String        'передаем имя сервера где находится БД 'Подписанты'
    Property Set SetPathDBSigned     As String        'передаем путь к БД 'Подписанты'
    Property Set SetNotesDocument     As NotesDocument'передаем NotesDocument в котором нужно проверить аттач
    Property Set SetItemName         As string        'передаем наименование итема в котором нужно проверить аттач
       
    Function VerifySignedXML(pathCriptoGSS As String, server_nameDB As String, pathDB As String, pathFile As String) As Boolean
    -ф-ция используется для проверки файла XML находящегося на диске
   
    где: pathCriptoGSS     - путь к consolecriptogss, например "c:\consolecriptogss\consolecriptogss.exe"
         server_nameDB     - название сервера где находится БД 'Подписанты',если текущий сервер - оставлем пустым
         pathDB         - путь к базе 'Подписанты', если база находится по пути "promdoc\SignVerify.nsf" - оставляем пустым
         pathFile         - путь к проверяемому файлу
    если перед вызовом данной ф-ции использовались нужные сеттеры - все либо нужные аргументы оставляем пустыми
       
    Function VerifySignedXMLFromDoc(pathCriptoGSS As String, server_nameDB As String, pathDB As String, doc As Variant, itemname As String) As Boolean
    -ф-ция используется для проверки файла XML находящегося в виде аттача в NotesDocument
   
    где: pathCriptoGSS     - путь к consolecriptogss, например "c:\consolecriptogss\consolecriptogss.exe"
         server_nameDB     - название сервера где находится БД 'Подписанты',если текущий сервер - оставлем пустым
         pathDB         - путь к базе 'Подписанты', если база находится по пути "promdoc\SignVerify.nsf" - оставляем пустым
         doc             - NotesDocument в котором находится проверяемый аттач(если документ был определен через сеттер - указываем Nothing)
         itemname         - название итема в котором находится проверяемый аттач
    если перед вызовом данной ф-ции использовались нужные сеттеры - все либо нужные аргументы оставляем пустыми
                       
       
==================================1 Пример работы с классом(проверяем файл на диске)============================================
   
    Dim verify_p  As New Verify_Signed_XML
   
    verify_p.SetPathXML="c:\XML\podpisant.xml" 'как вариант использую сеттер, а можно передать и прям в ф-ции VerifySignedXML
    If Not verify_p.VerifySignedXML("C:\ConsoleCriptoGSS\ConsoleCriptoGSS.exe", "", "", "") Then
        Messagebox "Была ошибка во время проверки либо документ не прошел успешно проверку"       
    Else
        Messagebox "Документ успешно проверен"
    End If

'далее при необходимости можем использовать методы для получения информации об ошибке, подписантах и т.д.   

    if verify_p.isError then s="Текст ошибки: "+verify_p.GetErrorText+Chr(13) 'если есть ошибка получаем текст ошибки

    s=s+"Код организации: "+verify_p.GetKodMedOrg+Chr(13)
    s=s+"Кол-во подписантов XML в теге: "+Cstr(verify_p.GetCountListTeg)+Chr(13)   

'I способ получения информации о подписантах (проверяем на NULL)
    mas=verify_p.GetListTeg 'получаем массив данных с подписантами в теге
    If Not Isnull(mas) Then
        Forall v In mas
            tmp=tmp+Chr(13)+v.FIO
            tmp=tmp+Chr(13)   
        End Forall
        s=s+"Список из тега:"+tmp+Chr(13)
    End If
   
    s=s+"Кол-во в ЭП: "+Cstr(verify_p.GetCountListEP)+Chr(13)
'II способ получения информации о подписантах (если кол-во подписантов > 0 - получаем список этих подписантов)       
    If verify_p.GetCountListFIOEP>0 Then
        mas=verify_p.GetListFIOEP 'получаем массив данных с подписантами в эл.подписи
        tmp=""
        Forall v In mas
            tmp=tmp+Chr(13)+v.FIO
            tmp=tmp+Chr(13)+v.UINFL
            tmp=tmp+Chr(13)+v.UINUL
            tmp=tmp+Chr(13)+v.UINOIGV
            tmp=tmp+Chr(13)           
        End Forall
        s=s+"Список из ЭП:"+tmp+Chr(13)
    End If
   
    s=s+"Кол-во кому разрешено: "+Cstr(verify_p.GetCountListPodp)+Chr(13)
    If verify_p.GetCountListFIOPodp>0 Then
        mas=verify_p.GetListFIOPodp    'получаем массив данных с подписантами из базы подписанты
        tmp=""
        Forall v In mas
            tmp=tmp+Chr(13)+v.FIO
            tmp=tmp+Chr(13)+v.UINFL
            tmp=tmp+Chr(13)+v.UINUL
            tmp=tmp+Chr(13)+v.UINOIGV
            tmp=tmp+Chr(13)
        End Forall
        s=s+"Список из подписантов:"+tmp
    End If
    Messagebox s
   
==================================2 Пример работы с классом(проверяем аттач в нотес доке)============================================
   
    Dim verify_p  As New Verify_Signed_XML, doc As notesdocument, ws As New NotesUIWorkspace
   
    Set doc = ws.CurrentDocument.Document
   
    verify_p.SetPathCriptoGSS="C:\ConsoleCriptoGSS\ConsoleCriptoGSS.exe"
    Set verify_p.SetNotesDocument=doc
    verify_p.SetItemName="text"
   
    If Not verify_p.VerifySignedXMLFromDoc("", "", "", Nothing, "") Then
        Messagebox "Была ошибка во время проверки либо документ не прошел успешно проверку"       
    Else
        Messagebox "Документ успешно проверен"
    End If
    'далее, как и в 1примере, можем получать нужную нам информацию из класса
%END REM

Public Class Verify_Signed_XML   
    Private m_ListSignSoprovod() As Lico    'список подписавших в теге XML(считается только один, не делаю анализ на ентеры и тому подобное, беру все что есть в теге)
    Private m_ListSignEP() As Lico        'список подписавших в ЭП
    Private m_ListSignPodp() As Lico        'список имеющих право подписи в организации
    Private m_Ubound_idx_SignSoprovod As Integer
    Private m_Ubound_idx_SignEP As Integer
    Private m_Ubound_idx_SignPodp As Integer
    Private m_kod_med As String
    Private m_kod_med_sub As String   
    Private m_name_org As String
   
    Private m_path_criptoGSS As String     'путь к консольной криптоГСС
    Private m_path_XML As String         'путь к проверяемому файлу
    Private m_name_XML As String         'имя проверяемому вложения
    Private m_serverDB_Signed As String 'сервер где находится БД подписанты
    Private m_pathDB_Signed As String     'путь к БД подписанты
   
    Private m_isError As Boolean
    Private m_error_Text As String
   
    Private m_doc As NotesDocument 'нотес документ в котором проверяемый итем с файлом
    Private m_item_Name As String 'название итема с файлом
   
    Public Sub New       
        me.m_path_criptoGSS=""
        me.m_path_XML=""
        me.m_serverDB_Signed=""
        me.m_pathDB_Signed=""
        Set me.m_doc=Nothing
        me.m_item_Name=""
        me.m_name_XML=""
       
        Call me.RestoreNULL       
    End Sub
   
    Public Function VerifySignedXML(pathCriptoGSS As String, server_nameDB As String, pathDB As String, pathFile As String) As Boolean
        On Error GoTo errh
        VerifySignedXML=False
        Call me.RestoreNULL
               
        Dim mas1 As Variant, mas2 As Variant, mas3 As Variant, b_tmp As Boolean, mes As String
        Dim tmp1 As String, tmp2 As String, tmp3 As String, i As Integer
        b_tmp=False
       
        If Not Trim(pathCriptoGSS)=""     Then Me.m_path_criptoGSS=pathCriptoGSS
        If Not Trim(server_nameDB)=""     Then Me.m_serverDB_Signed=server_nameDB
        If Not Trim(pathDB)=""             Then Me.m_pathDB_Signed=pathDB
        If Not Trim(pathFile)=""         Then Me.m_path_XML=pathFile
           
        If Not Proverka Then mes=me.m_error_Text: Error 1000
                
        If Not me.GetSoprovod     Then mes="Ошибка получения списка подписей из тега. "+ me.m_error_Text: Error 1000
        If Not me.GetSignFile     Then mes="Ошибка получения списка ЭП. "+ me.m_error_Text: Error 1000
        If Not me.GetPodpisant     Then mes="Ошибка получения списка людей имеющих право подписывать. "+ me.m_error_Text: Error 1000
       
        Dim mas_tmp As Variant       
        ForAll v1 In me.m_ListSignSoprovod'(v1.FIO=Иванов И.И. или И.И. Иванов или Иванов И. И. или И. И. Иванов)                       
            mas_tmp=Split(UCase(Trim(v1.FIO)), " ")
            If UBound(mas_tmp)=1 Or UBound(mas_tmp)=2 Then
                i=0
                ReDim mas1(1)
                ForAll v In mas_tmp
                    If InStr(v,".")=0 Then'если фамилия (нет точки)
                        mas1(0)=Trim(v)
                    Else
                        If i=0 Then mas1(1)=Trim(v) Else mas1(1)=mas1(1)+Trim(v)
                        i=1
                    End If
                End ForAll               
                mas1(1)=Replace(mas1(1),". ",".")
                tmp1=mas1(0)+" "+mas1(1)               
                tmp1=me.TrimForNoRus(tmp1) 'оставим только кирилические символы, точки и пробел
                If Mid$(tmp1,Len(tmp1),1)<>"." Then tmp1=tmp1+"."    'иногда может встречаться И.О без точки после О
                Print "ФИО из сопровода из тега - //" +tmp1+"//"               
                ForAll v2 In me.m_ListSignEP'(v2.FIO=Иванов Иван Иванович) - из ЭП
                    mas2=Split(Trim(UCase(v2.FIO)), " ")'mas1(0)=ИВАНОВ     mas1(1)=ИВАН    mas1(2)=ИВАНОВИЧ                   
                    tmp2=Trim(mas2(0))+" "+ Trim(Left$(mas2(1), 1)+"."+Left$(mas2(2), 1)+".")
                    tmp2=me.TrimForNoRus(tmp2) 'оставим только кирилические символы, точки и пробел
                    Print "ФИО из ЭП - //" +tmp2+"//"   
                    If tmp1=tmp2 Then
                        ForAll v3 In me.m_ListSignPodp'(v3.FIO=Иванов Иван Иванович)
                            mas3=Split(Trim(UCase(v3.FIO)), " ")
                            tmp3=Trim(mas3(0))+" "+Trim(Left$(mas3(1), 1)+"."+Left$(mas3(2), 1)+".")
                            tmp3=me.TrimForNoRus(tmp3)'оставим только кирилические символы, точки и пробел
                            Print "ФИО из БД 'Подписанты' - //" +tmp3+"//"                           
                            If tmp3=tmp2 Then
                                If v2.UINFL=v3.UINFL And ((v2.UINUL<>"" And v2.UINUL=v3.UINUL) Or (v2.UINOIGV<>"" And v2.UINOIGV=v3.UINOIGV)) Then
                                    b_tmp=True : GoTo end_func
                                End If                                   
                            End If                           
                        End ForAll
                    End If
                End ForAll                                           
            End If
        End ForAll                       
       
end_func:
        If Not b_tmp Then mes="Нет совпадения подписантов.": Error 1000       
        Print "Совпадение подписантов найдено. Проверка пройдена успешно."
        VerifySignedXML=True
        Exit Function
errh:   
        If Not me.m_isError Then mes="Не удалось проверить подписантов. "+mes
        Call me.SetError(Err, mes)
        Exit Function
    End Function

    Public Function VerifySignedXMLFromDoc(pathCriptoGSS As String, server_nameDB As String, pathDB As String, doc As Variant, itemname As String) As Boolean
        On Error GoTo errh
        VerifySignedXMLFromDoc=False
        me.m_name_XML=""
        Call me.RestoreNULL
        Dim db As NotesDatabase, rtitem As NotesRichTextItem, mes As String, obj As Variant
       
        If Not Trim(pathCriptoGSS)=""     Then Me.m_path_criptoGSS=pathCriptoGSS
        If Not Trim(server_nameDB)=""     Then Me.m_serverDB_Signed=server_nameDB
        If Not Trim(pathDB)=""             Then Me.m_pathDB_Signed=pathDB
        If Not doc Is Nothing             Then Set me.m_doc=doc       
        If Not Trim(itemname)=""         Then me.m_item_name=itemname
       
        If me.m_doc Is Nothing             Then mes="Ошибка!!! Не передан NotesDocument": Error 1000
        If Trim(Me.m_item_name)=""         Then mes="Ошибка!!! Не указано название итема содержащего аттач": Error 1000   
       
        If Not me.m_doc.HasEmbedded                 Then  mes="Ошибка!!! В NotesDocument нет аттача": Error 1000
        If Not me.m_doc.HasItem(me.m_item_Name)     Then  mes="Ошибка!!! В NotesDocument нет указанного итема": Error 1000
       
        Set rtitem = me.m_doc.GetFirstItem(me.m_item_Name)
        If rtitem Is Nothing                 Then mes="Ошибка!!! Не могу получить объект итема": Error 1000
        If IsEmpty(rtitem.EmbeddedObjects)     Then mes="Ошибка!!! В указанном итеме нет аттача": Error 1000
       
        Set obj=rtitem.EmbeddedObjects(0)
        If  Not (obj.Type = EMBED_ATTACHMENT) Then mes="Ошибка!!! В указанном итеме объект не является аттачем": Error 1000
        If  Not  LCase(StrRightBack(obj.Source , ".")) = "xml"  Then mes="Ошибка!!! Аттач не является XML файлом": Error 1000
       
        me.m_name_XML=obj.Source
        Me.m_path_XML=me.GetNotesTempDirectory+obj.Source
               
        If Not Proverka Then mes=me.m_error_Text: Error 1000
       
        Call obj.ExtractFile(Me.m_path_XML)
       
        If Not VerifySignedXML(Me.m_path_criptoGSS, Me.m_serverDB_Signed, Me.m_pathDB_Signed, Me.m_path_XML)Then
            mes=Me.m_error_Text
            Kill me.m_path_XML
            Error 1001
        End If
        
        Kill me.m_path_XML
        VerifySignedXMLFromDoc=True
        Exit Function
errh:           
        If Not Err=1001 Then mes="Не удалось проверить подписантов. "+mes       
        Call me.SetError(Err, mes)
        Exit Function
    End Function
   
'геттеры
    Public Property Get GetListTeg As Variant
        On Error GoTo errh
        Dim mes As String
        If me.m_Ubound_idx_SignSoprovod=-1 Then mes="Нет подписей в сопроводе": Error 1000
        GetListTeg=me.m_ListSignSoprovod
        Exit Property
errh:
        GetListTeg=Null
        Call me.SetError(Err, mes)
        Exit Property
    End Property
       
    Public Property Get GetListEP As Variant
        On Error GoTo errh
        Dim mes As String
        If me.m_Ubound_idx_SignEP=-1 Then mes="Нет подписей ЭП": Error 1000
        GetListEP=me.m_ListSignEP
        Exit Property
errh:
        GetListEP=Null
        Call me.SetError(Err, mes)
        Exit Property
    End Property
   
    Public Property Get GetListPodp As Variant
        On Error GoTo errh
        Dim mes As String
        If me.m_Ubound_idx_SignPodp=-1 Then mes="Нет данных ведомству о подписантах": Error 1000
        GetListPodp=me.m_ListSignPodp
        Exit Property
errh:
        GetListPodp=Null
        Call me.SetError(Err, mes)
        Exit Property
    End Property
   
    Public Property Get GetNameXML As String
        GetNameXML=me.m_name_XML       
    End Property
   
    Public Property Get GetNameOrg As String
        GetNameOrg=me.m_name_org       
    End Property   
    Public Property Get GetKodMedOrg As String
        GetKodMedOrg=me.m_kod_med
        If Not me.m_kod_med_sub="" Then GetKodMedOrg=GetKodMedOrg+"."+me.m_kod_med_sub
    End Property   
    Public Property Get GetCountListTeg As Integer
        GetCountListTeg=me.m_Ubound_idx_SignSoprovod+1
    End Property
    Public Property Get GetCountListEP As Integer
        GetCountListEP=me.m_Ubound_idx_SignEP+1
    End Property
    Public Property Get GetCountListPodp As Integer
        GetCountListPodp=me.m_Ubound_idx_SignPodp+1
    End Property       
    Public Property Get isError As Boolean
        isError=me.m_isError
    End Property   
    Public Property Get GetErrorText As String
        GetErrorText=me.m_error_Text
    End Property
'сеттеры******************
    Public Property Set SetPathCriptoGSS As String
        me.m_path_criptoGSS=SetPathCriptoGSS
    End Property
   
    Public Property Set SetPathXML As String
        me.m_path_XML=SetPathXML
    End Property
    Public Property Set SetServerDBSigned As String
        me.m_serverDB_Signed=SetServerDBSigned
    End Property
    Public Property Set SetPathDBSigned As String
        me.m_pathDB_Signed=SetPathDBSigned
    End Property   
    Public Property Set SetNotesDocument As NotesDocument
        Set me.m_doc=SetNotesDocument
    End Property
    Public Property Set SetItemName As String
        me.m_item_name=SetItemName
    End Property   
   
'**********************************************************************************************       
    Private Function GetSoprovod As Boolean'подписанты тег XML
        On Error GoTo errh
        Dim sax As New SAX_Parser, mes As String, i As Integer, mas As Variant, record As Variant
        GetSoprovod=False
        If Not sax.run(Me.m_path_XML) Then Error 1000
       
        me.m_kod_med=sax.GetKodMed
        me.m_kod_med_sub=sax.GetKodMedSub
       
        If sax.GetCountListFIO>0 Then       
            mas=sax.GetListFIO    'получаем тестовый массив               
            For i=0 To sax.GetCountListFIO-1
                Set record=New Lico
                record.FIO=mas(i)
                record.UINFL    =""
                record.UINUL    =""
                record.UINOIGV    =""
                ReDim Preserve me.m_ListSignSoprovod(i)
                Set me.m_ListSignSoprovod(i)=record                               
            Next           
            Me.m_Ubound_idx_SignSoprovod=sax.GetCountListFIO-1
        Else
            mes="Ошибка!!! В документе нет подписантов в теге"
            Error 1000
        End If
        GetSoprovod=True
        Exit Function
errh:       
        If Not sax Is Nothing Then mes=sax.GetErrorText()
        Call me.SetError(Err, mes)
        Exit Function
    End Function   
   
    Private Function GetSignFile As Boolean'подписанты ЭП
        On Error GoTo errh
        Dim verify_class As New Verify_CriptoGSS
        Dim i As Integer, mes As String, record As Variant
        GetSignFile=False
        If Not verify_class.SetAllArg(Me.m_path_criptoGSS, "All", Me.m_path_XML) Then  mes=verify_class.GetTextError: Error 1000
        If Not verify_class.verify Then mes=verify_class.GetTextError: : Error 1000
       
        If verify_class.CountListSertInDoc>0 Then           
            For i=0 To verify_class.CountListSertInDoc-1
                Set record=New Lico
                With verify_class.GetListSertInDoc(i).Certificate
                    record.FIO        =.FIO
                    record.UINFL    =.UINFL
                    record.UINUL    =.UINUL
                    record.UINOIGV    =.UINOIGV   
                End With       
               
                ReDim Preserve me.m_ListSignEP(i)
                Set me.m_ListSignEP(i)=record                                                           
            Next
            Me.m_Ubound_idx_SignEP=verify_class.CountListSertInDoc-1
        Else
            mes="Ошибка!!! В документе нет подписантов ЭП"
            Error 1000       
        End If
        GetSignFile=True   
        Exit Function
errh:           
        Call me.SetError(Err, mes)
        Exit Function
    End Function
   
    Private Function GetPodpisant As Boolean
        On Error GoTo errh
       
        GetPodpisant=False   
       
        Dim mas As Variant, mes As String, key As String, i As Integer
       
        If me.m_kod_med="" Then mes="Ошибка!!! Не получен код ведомства": Error 1000
       
        Dim p_class As New Podpisant
       
        key=me.m_kod_med
        If Not me.m_kod_med_sub="" Then key=key+"."+me.m_kod_med_sub
       
        If Not p_class.RunGetPodpisant(me.m_serverDB_Signed, me.m_pathDB_Signed, key) Then    mes=p_class.GetErrorText : Error 1000
   
        me.m_name_org=p_class.GetNameOrg
       
        If p_class.GetCountListPodp>0 Then       
            mas=p_class.GetListPodp                'получаем уже массив объектов класса Lico   
            For i=0 To p_class.GetCountListPodp-1                   
                ReDim Preserve me.m_ListSignPodp(i)
                Set me.m_ListSignPodp(i)=mas(i)                           
            Next           
            Me.m_Ubound_idx_SignPodp=p_class.GetCountListPodp-1                       
        Else
            mes="Ошибка!!! В документе нет подписантов в теге"
            Error 1000
        End If
        %REM ' можно и так получить список
        mas=p_class.GetListFIOPodp
        If Not IsNull(mas) Then           
            For i=0 To UBound(mas)
                ReDim Preserve me.m_ListSignPodp(i)
                Set me.m_ListSignPodp(i)=mas(i)               
            Next
            me.m_Ubound_idx_SignPodp=p_class.GetCountListFIOPodp-1
        Else
            mes="Не указаны подписанты по данному ведомству"
            Error 1000
        End If   
        %END REM                       
       
        GetPodpisant=True
        Exit Function
errh:           
        Call me.SetError(Err, mes)
        Exit Function
    End Function
   
    Private Function Proverka As Boolean
        On Error GoTo errh
        Proverka=False
        Dim mes As String
        If Trim(Me.m_path_criptoGSS)=""      Then mes="Ошибка!!! Не указан путь к ConsoleCriptoGSS": Error 1000
        'If Trim(Me.m_serverDB_Signed)=""     Then mes="Ошибка!!! Не указан сервер базы '"+db_title+"'": Error 1000
        'If Trim(Me.m_pathDB_Signed)=""      Then mes="Ошибка!!! Не указан путь к базе '"+db_title+"'": Error 1000
        If Trim(Me.m_path_XML)=""             Then mes="Ошибка!!! Не указан путь к проверяемому файлу": Error 1000
        Proverka=True
        Exit Function
errh:           
        Call me.SetError(Err, mes)
        Exit Function
    End Function

    Private Function TrimForNoRus(value As String) As String 'оставляем только кирилицу,пробел и точки
        On Error GoTo errh
        Dim i As Integer, s As String, ch As String, tmp_str As String
        TrimForNoRus=""
        s=""
        For i=1 To Len(value)
            ch=Mid$(value,i,1)
            If Asc(ch)=32 Or Asc(ch)=46 Or Asc(ch)=168 Or Asc(ch)=184 Or (Asc(ch)>=192 And Asc(ch)<=255) Then
                TrimForNoRus=TrimForNoRus+ch
            Else
                s=s+"//Символ '"+ch+"', код ASCII="+CStr(Asc(ch))
            End If
        Next           
        If s<>"" Then Print "в значении '"+value+"' встретились не кирилличесике символы: "+s
        Exit Function
errh:
        Print "в ф-ции TrimForNoRus произошла ошибка № " & Err & " в строке " & Erl
        TrimForNoRus=value
        Exit Function
    End Function
   
    Private Sub RestoreNULL
        me.m_isError=False
        me.m_error_Text=""
        Me.m_Ubound_idx_SignSoprovod=-1       
        Me.m_Ubound_idx_SignEP        =-1
        Me.m_Ubound_idx_SignPodp    =-1
       
        Me.m_kod_med=""
        Me.m_kod_med_sub=""
       
        If IsArray(me.m_ListSignSoprovod)    Then Erase me.m_ListSignSoprovod
        If IsArray(me.m_ListSignEP)         Then Erase me.m_ListSignEP   
        If IsArray(me.m_ListSignPodp)        Then Erase me.m_ListSignPodp
    End Sub
   
    Private Sub SetError(Er As Integer, mes As String)'записываем ошибку
        Me.m_isError=True
        If er>=1000 And er<=1100 Then
            Me.m_error_Text=mes           
        Else
            Me.m_error_Text="Ошибка № " & Er & " в строке " & Erl & Chr(13) & Error(Er)           
        End If       
    End Sub
   
    Private Function GetNotesTempDirectory() As String'Путь для временных файлов
        Dim d As String * 256
        Dim s%
        s% = w32_OSGetSystemTempDirectory(d)
        GetNotesTempDirectory = Left$(d, s%) +"\"
    End Function
End Class

    Public Function RunGetPodpisant(server_nameDB As String, pathDB As String, kod_org As String) As Boolean
        On Error GoTo errh
       
        Call me.RestoreNULL
       
        RunGetPodpisant=False       
        Dim session As New NotesSession, db As NotesDatabase, view As NotesView, doc_p As NotesDocument
        Dim mes As String, i As Integer, view_name As String, db_title2 As String, record As Variant
       
        If Not Trim(server_nameDB)=""     Then Me.m_serverDB_Signed=server_nameDB
        If Not Trim(pathDB)=""             Then Me.m_pathDB_Signed=pathDB
        If Not Trim(kod_org)=""         Then Me.m_kod_org=kod_org
       
        view_name="On_OrgKod"
               
        If Trim(Me.m_serverDB_Signed)=""     Then mes="Не указан сервер базы '"+db_title+"'": Error 1000
        If Trim(Me.m_pathDB_Signed)=""      Then mes="Не указан путь к базе '"+db_title+"'": Error 1000
        If Trim(Me.m_kod_org)=""             Then mes="Не указан код организации": Error 1000
       
        Set db = session.GetDatabase(me.m_serverDB_Signed, me.m_pathDB_Signed)
        If Not db.IsOpen Then mes="Нет подключения к базе '"+db_title+"'": Error 1000
        db_title2=db.Title
        Set view=db.Getview(view_name)
        If view Is Nothing Then mes="Не могу найти служебное представление '"+view_name+"' в базе '"+db_title2+"'": Error 1000
       
        Set doc_p=view.Getdocumentbykey(me.m_kod_org, True)
        If doc_p Is Nothing Then mes="Не найден документ организации в базе '"+db_title2+"'": Error 1000
       
        If Not doc_p.Hasitem("fam")    Or Not doc_p.Hasitem("im") Or Not doc_p.Hasitem("ot") Or Not doc_p.Hasitem("ern") _
        Then mes="Не заполнен документ организации в базе '"+db_title2+"'": Error 1000       
        If Trim(doc_p.fam(0))="" Or Trim(doc_p.im(0))="" Or Trim(doc_p.ot(0))="" Or Trim(doc_p.ern(0))="" _
        Then mes="Не заполнен документ организации в базе '"+db_title2+"'": Error 1000
       
        ForAll v In doc_p.NameOrg
            If me.m_name_org="" Then me.m_name_org=v Else me.m_name_org=me.m_name_org+Chr(13)+v   
        End ForAll
       
        For i=0 To UBound(doc_p.fam)           
            Set record=New Lico           
            record.FIO=doc_p.fam(i)
            record.FIO=record.FIO+" "+doc_p.im(i)
            record.FIO=record.FIO+" "+doc_p.ot(i)
            record.UINFL=doc_p.ern(i)
            record.UINUL=doc_p.ernul(i)
            record.UINOIGV=doc_p.ernoigv(i)
           
            ReDim Preserve me.m_ListSignPodp(i)           
            Set me.m_ListSignPodp(i)=record
            me.m_Ubound_idx_SignPodp=i
        Next
       
        RunGetPodpisant=True
        Exit Function
errh:           
        If Err=1000 Then mes="Ошибка получения данных!!! "+mes
        Call me.SetError(Err, mes)
        Exit Function
    End Function
   
'геттеры******************
    Public Property Get GetListPodp As Variant
        On Error GoTo errh
        Dim mes As String
        If me.m_Ubound_idx_SignPodp=-1 Then mes="Нет данных по ведомству о подписантах": Error 1000
        GetListPodp=me.m_ListSignPodp
        Exit Property
errh:
        GetListPodp=Null
        Call me.SetError(Err, mes)
        Exit Property
    End Property

    Public Property Get GetCountListPodp As Integer
        GetCountListPodp=me.m_Ubound_idx_SignPodp+1
    End Property   
    Public Property Get GetNameOrg As String
        GetNameOrg=me.m_name_org       
    End Property
    Public Property Get GetErrorText As String
        GetErrorText=me.m_error_Text
    End Property
'сеттеры******************   
    Public Property Set SetServerDBSigned As String
        me.m_serverDB_Signed=SetServerDBSigned
    End Property
    Public Property Set SetPathDBSigned As String
        me.m_pathDB_Signed=SetPathDBSigned
    End Property   
    Public Property Set SetKodOrg As String
        me.m_kod_org=SetKodOrg
    End Property   
'**********************************************************************************************   
    Private Sub RestoreNULL
        me.m_isError=False
        me.m_error_Text=""
        Me.m_Ubound_idx_SignPodp=-1
       
        me.m_name_org=""
        If IsArray(me.m_ListSignPodp)        Then Erase me.m_ListSignPodp
    End Sub
   
    Private Sub SetError(Er As Integer, mes As String)'записываем ошибку
        Me.m_isError=True
        If er>=1000 And er<=1100 Then
            Me.m_error_Text=mes           
        Else
            Me.m_error_Text="Ошибка № " & Er & " в строке " & Erl & Chr(13) & Error(Er)           
        End If       
    End Sub
End Class

%REM
    Library VerifySignedXML
    Created Aug 18, 2021 by Гроза Вадим Иванович/Home
    Description:Библиотека для проверки подписи в документе XML и сравнение подписей с базой подписанты   

для работы данной библиотеки необходимо наличие других библиотек
"ConsoleCriptoGSS_2.0"   
"ls.snapps.JSONReader"

для проверки - используем класс Verify_Signed_XML
%END REM
Option Public
Option Declare

Use "ConsoleCriptoGSS_2.0"

%REM
    Sub ZapolnTypeFiles
    Description: указываем разрешенные типы файлов
    ' [url]https://ru.wikipedia.org/wiki/Список_MIME-типов[/url]      -   подсказка
    ' [url]https://wp-kama.ru/id_8643/spisok-rasshirenij-fajlov-i-ih-mime-tipov.html[/url]    - тут поболее типов
%END REM
Sub ZapolnTypeFiles
    c_files_MIME("docx")    =    {href="data:application/msword;base64,}
    c_files_MIME("doc")        =    {href="data:application/msword;base64,}
    c_files_MIME("docm")    =    {href="data:application/msword;base64,}
    c_files_MIME("rtf")        =    {href="data:application/msword;base64,}
    c_files_MIME("jpeg")    =    {href="data:image/jpeg;base64,}
    c_files_MIME("jpg")        =    {href="data:image/jpeg;base64,}
    c_files_MIME("pdf")        =    {href="data:application/pdf;base64,}
    c_files_MIME("xls")        =    {href="data:application/vnd.ms-excel;base64,}
    c_files_MIME("xlsx")    =    {href="data:application/vnd.ms-excel;base64,}
    c_files_MIME("tif")        =    {href="data:image/tif;base64,}
    c_files_MIME("xml")        =    {href="data:application/xml;base64,}
    c_files_MIME("rar")        =    {href="data:application/x-rar-compressed;base64,}
    c_files_MIME("zip")        =    {href="data:application/zip;base64,}
    c_files_MIME("txt")        =    {href="data:text/plain;base64,}    
    c_files_MIME("ppt")        =    {href="data:application/vnd.ms-powerpoint;base64,}
    c_files_MIME("pptx")    =    {href="data:application/vnd.ms-powerpoint;base64,}
    c_files_MIME("vsd")        =    {href="data:application/vnd.visio;base64,}
    c_files_MIME("vsdx")    =    {href="data:application/vnd.visio2013;base64,}
End Sub

    WrdAppTmp.Documents.Add ("Normal")   '("C:\XML\tempdoc.docx")
    Set WrdDocTmp = WrdAppTmp.ActiveDocument
    WrdDocTmp.Select
   
    Set mypar = WrdDocTmp.Paragraphs(1)
    mypar.range.Find.ClearFormatting
    mypar.range.Paste
   
    WrdAppTmp.ChangeFileOpenDirectory datpatch
    Call WrdDocTmp.SaveAs  ("doctmp.html", 10,False, "",False,"",,,,,,,,,, )
    WrdDocTmp.Close
    WrdAppTmp.Quit
    Set WrdAppTmp = Nothing
    Print  "сохранили в html"
   
    ' Вырезаем с doctmp.html текст письма
    Set session = New NotesSession
    Set htmlStream = session.CreateStream
    Call htmlStream.Open(datpatch+"doctmp.html")
    mytext$=""
    mytext$ = htmlStream.ReadText
    Call htmlStream.Close
    Print "прочитали и закрыли html"
'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!   
    'здесь нужно почистить тест дока от внешней таблицы
%REM может быть что текст вставили с таблицей и получилась вложенная таблица
    1начало файла
<table class=MsoTableGrid border=0 cellspacing=0 cellpadding=0
style='border-collapse:collapse;border:none'>
     <tr>
      <td width=657 valign=top style='width:492.7pt;padding:0cm 5.4pt 0cm 5.4pt'>
        <table class=MsoTableGrid border=0 cellspacing=0 cellpadding=0
         style='border-collapse:collapse;border:none'>
         <tr>
          <td width=657 valign=top style='width:492.7pt;padding:0cm 5.4pt 0cm 5.4pt'>
          <p
            2сам текст документа
          </td>
         </tr>
        </table>
      </td>
    </tr>
</table>
3конец файла
%END REM
    str1=StrLeft(mytext$,"<table") 'взяли начало файла до таблицы (начало файла)
       
    'стало в версии 1.1(заменили алгоритм получения str2)   
'НАЧАЛО ПОЛУЧЕНИЯ str2
    idx=InStr(Len(str1+"<table"),mytext$,"<td")
    idx=InStr(idx,mytext$,">")
    str0=Mid$(mytext$, idx+1)
    str2=StrLeftBack(str0,"</td>") 'взяли все что до последней строки внешней ячейки
'КОНЕЦ ПОЛУЧЕНИЯ str2   
    str3=StrRightBack(mytext$,"</table>") 'взяли все что после последней строки внешней ячейки (конец файла)
    mytext$=str1+str2+str3
       
    Textword=ParsHtmlText(mytext$)   
    Print "ФУНКЦИЯ - конец Textword."
    Exit Function
   
ErrH:
    Print "Библиотека 'MED_XML' ф-ция 'Textword'. Ошибка " & Error(Err) & " в строке " & Erl   
End Function

%REM
    Function Strclean22
    Description: Comments for Function
%END REM
Function Strclean22 (mystr As String) As String
    On Error GoTo ErrH
    Dim ascx As String, tmpstr  As String, lenstr As Variant, x As Variant
    tmpstr= ""
    'Strclean22=mystr
    'Exit function
    tmpstr=mystr
    lenstr = Len(mystr)
    'MsgBox mystr
    '%REM
    For x=1 To lenstr 'очищаем от ненужных символов (указываем только те - которые нужны)
        ascx =  Mid$(mystr,x,1) 
        '        If (Asc(ascx)>31) And (Asc(ascx)<38) Or ( Asc(ascx)>38 And Asc(ascx)<153) Or (Asc(ascx)>191)  And (Asc(ascx)<256) _
        '        Or (Asc(ascx)=171)  Or (Asc(ascx)=187) Or (Asc(ascx)=185) Then        
        If (Asc(ascx)>31 And Asc(ascx)<38) Or ( Asc(ascx)>38 And Asc(ascx)<153) Or (Asc(ascx)>191 And Asc(ascx)<256) _
        Or Asc(ascx)=163 Or Asc(ascx)=165 Or Asc(ascx)=168_
        Or Asc(ascx)=170 Or Asc(ascx)=171 Or Asc(ascx)=175 Or Asc(ascx)=178 Or Asc(ascx)=179_
        Or Asc(ascx)=180 Or (Asc(ascx)>=184 And Asc(ascx)<=187)_
        Or Asc(ascx)=191 Or Asc(ascx)=177 Then                
        tmpstr = tmpstr + ascx
    End If
Next
    'Strclean22=mystr
    'Exit function
    'MsgBox tmpstr    
    '%END REM
    
    'HTML символы заменяем (появляются после сохрания в html)   [url]http://_.ascii.cl/htmlcodes.htm[/url]
    
    
    '%REM
    tmpstr = Replace(tmpstr,{quot;},{&quot;})  ' "
    tmpstr = Replace(tmpstr,{amp;},{&amp;})  ' &
    
    tmpstr = Replace(tmpstr,{lt;},{&lt;})  ' <
    tmpstr = Replace(tmpstr,{gt;},{&gt;})  ' >
    
    tmpstr = Replace(tmpstr,{nbsp;},{&nbsp;})  ' неразрывный пробел
    tmpstr = Replace(tmpstr,{iexcl;},{&iexcl;})  
    tmpstr = Replace(tmpstr,{cent;},{&cent;})  
    tmpstr = Replace(tmpstr,{pound;},{&pound;})  
    tmpstr = Replace(tmpstr,{curren;},{&curren;})  
    tmpstr = Replace(tmpstr,{yen;},{&yen;})  
    tmpstr = Replace(tmpstr,{brvbar;},{&brvbar;})  
    tmpstr = Replace(tmpstr,{sect;},{&sect;})  
    tmpstr = Replace(tmpstr,{uml;},{&uml;})  
    tmpstr = Replace(tmpstr,{copy;},{&copy;})  
    tmpstr = Replace(tmpstr,{laquo;},{&laquo;})  
    tmpstr = Replace(tmpstr,{reg;},{&reg;})  
    tmpstr = Replace(tmpstr,{macr;},{&macr;})  
    
    tmpstr = Replace(tmpstr,{euro;},{&euro;})  
    
    tmpstr = Replace(tmpstr,{sup1;},{&#185;})  ' верхний индекс "один"
    tmpstr = Replace(tmpstr,{sup2;},{&#178;})  
    tmpstr = Replace(tmpstr,{sup3;},{&#179;})  
    
    tmpstr = Replace(tmpstr,{frac14;},{&#188;})  'дробь - одна четверть
    tmpstr = Replace(tmpstr,{frac12;},{&#189;})  '     дробь - одна вторая
    tmpstr = Replace(tmpstr,{frac34;},{&#190;})  'дробь - три четверти
    'MsgBox tmpstr    
    'удаляем пустые параграфы
    tmpstr = Replace(tmpstr,{<p><span style="padding:0px 10px;"></span></p>},"") 
    '%END REM
    'Msgbox tmpstr
    Strclean22  =    tmpstr
    

    Exit Function
ErrH:
    Print "Библиотека 'MED_XML' ф-ция 'Strclean'. Ошибка " & Error(Err) & " в строке " & Erl    
End Function

Function Strclean (mystr As String) As String
    On Error GoTo ErrH
    Dim ascx As String, tmpstr  As String, lenstr As Variant, x As Variant
    tmpstr= ""
    'tmpstr=mystr
    lenstr = Len(mystr)
    'MsgBox mystr
    '%REM
    For x=1 To lenstr 'очищаем от ненужных символов (указываем только те - которые нужны)
        ascx =  Mid$(mystr,x,1) 
'        If (Asc(ascx)>31) And (Asc(ascx)<38) Or ( Asc(ascx)>38 And Asc(ascx)<153) Or (Asc(ascx)>191)  And (Asc(ascx)<256) _
'        Or (Asc(ascx)=171)  Or (Asc(ascx)=187) Or (Asc(ascx)=185) Then        
        If (Asc(ascx)>31 And Asc(ascx)<38) Or ( Asc(ascx)>38 And Asc(ascx)<153) Or (Asc(ascx)>191 And Asc(ascx)<256) _
        Or Asc(ascx)=163 Or Asc(ascx)=165 Or Asc(ascx)=168_
        Or Asc(ascx)=170 Or Asc(ascx)=171 Or Asc(ascx)=175 Or Asc(ascx)=178 Or Asc(ascx)=179_
        Or Asc(ascx)=180 Or (Asc(ascx)>=184 And Asc(ascx)<=187)_
        Or Asc(ascx)=191 Or Asc(ascx)=177 Then                
            tmpstr = tmpstr + ascx
        End If
    Next
    'MsgBox tmpstr    
    '%END REM
    
'HTML символы заменяем (появляются после сохрания в html)   [url]http://_.ascii.cl/htmlcodes.htm[/url]
    

    tmpstr = Replace(tmpstr,{quot;},{&quot;})  ' "
    tmpstr = Replace(tmpstr,{amp;},{&amp;})  ' &
    
    tmpstr = Replace(tmpstr,{lt;},{&lt;})  ' <
    tmpstr = Replace(tmpstr,{gt;},{&gt;})  ' >
    
    tmpstr = Replace(tmpstr,{nbsp;},{&nbsp;})  ' неразрывный пробел
    tmpstr = Replace(tmpstr,{iexcl;},{&iexcl;})  
    tmpstr = Replace(tmpstr,{cent;},{&cent;})  
    tmpstr = Replace(tmpstr,{pound;},{&pound;})  
    tmpstr = Replace(tmpstr,{curren;},{&curren;})  
    tmpstr = Replace(tmpstr,{yen;},{&yen;})  
    tmpstr = Replace(tmpstr,{brvbar;},{&brvbar;})  
    tmpstr = Replace(tmpstr,{sect;},{&sect;})  
    tmpstr = Replace(tmpstr,{uml;},{&uml;})  
    tmpstr = Replace(tmpstr,{copy;},{&copy;})  
    tmpstr = Replace(tmpstr,{laquo;},{&laquo;})  
    tmpstr = Replace(tmpstr,{reg;},{&reg;})  
    tmpstr = Replace(tmpstr,{macr;},{&macr;})  
    
    tmpstr = Replace(tmpstr,{euro;},{&euro;})  
    
    tmpstr = Replace(tmpstr,{sup1;},{&#185;})  ' верхний индекс "один"
    tmpstr = Replace(tmpstr,{sup2;},{&#178;})  
    tmpstr = Replace(tmpstr,{sup3;},{&#179;})  
    
    tmpstr = Replace(tmpstr,{frac14;},{&#188;})  'дробь - одна четверть
    tmpstr = Replace(tmpstr,{frac12;},{&#189;})  '     дробь - одна вторая
    tmpstr = Replace(tmpstr,{frac34;},{&#190;})  'дробь - три четверти
    'MsgBox tmpstr    
    'удаляем пустые параграфы
    tmpstr = Replace(tmpstr,{<p><span style="padding:0px 10px;"></span></p>},"") 
    
    'fileNum% = Freefile()
    'Open  "C:\xml\temp.txt" For Append As fileNum%
    'Print # fileNum%, tmpstr
    'Close  fileNum%
    
    'Dim array1(1) As String ' для замены переносов строк в содержании
    'Dim array2(1) As String
    'array1(0) = Chr(13)
    'array1(1) = Chr(9)
    'array2(0) = "</p><p>"
    'array2(1) = {<span style="padding:0px 10px;"></span>}
    'tmpstr = Replace(tmpstr,array1,array2) 
    'tmpstr = "<p>" +  tmpstr + "</p>"
    
    'Msgbox tmpstr
    Strclean  =    tmpstr

    Exit Function
ErrH:
    Print "Библиотека 'MED_XML' ф-ция 'Strclean'. Ошибка " & Error(Err) & " в строке " & Erl    
End Function

    Call uidoc.save     
    Set L_doc = uidoc.Document   
   
    If Not proverka_import(tmp_tmp, b_templ) Then  MessageBox tmp_tmp : Exit Sub ' - ---   ПРОПУСКНАЯ СИСТЕМА
   
    L_docpatch = Environ$("TEMP") + "\" ' путь во временную папку
   
    'b_templ=false
    Select Case b_templ
        Case True:     Call ImportToWord         'используем настройки из документа шаблона
        Case False: Call ImportToWord_OLD    'работаем по старой схеме
    End Select
    Exit Sub
   
ErrH:
    Print "Библиотека 'MED_XML' ф-ция 'RunImportToWord'. Ошибка импорта в Word " & Error(Err) & " в строке " & Erl   
    Exit Sub
End Sub