Автоматизация задач в HCL Notes

@If(@IsNumber(TotalAmount); TotalAmount * 0.2; 0)

@If(Priority = "High"; "red"; Priority = "Medium"; "blue"; "black")

@Today > @Adjust(DueDate; 0; 0; -3; 0; 0; 0) & @Today <= DueDate & Status != "Completed"

@MailSend(ResponsiblePerson; ""; ""; "Напоминание о задаче: " + Subject; "Срок выполнения задачи '" + Subject + "' наступает " + @Text(DueDate) + ". Пожалуйста, убедитесь, что она будет выполнена вовремя."; ""); @Return("Notification sent to " + @Name([CN]; ResponsiblePerson))

@If(Discount > 0; Price - (Price * Discount / 100); Price)

@Command([MailForward]); @Command([EditPaste]; "Прошу рассмотреть данный вопрос.\n\nС уважением,\n" + @Name([CN]; @UserName)); @Command([FileSend])

Sub Initialize
    Dim session As New NotesSession
    Dim db As NotesDatabase
    Dim archiveDb As NotesDatabase
    Dim view As NotesView
    Dim doc As NotesDocument
    Dim archiveDoc As NotesDocument
    Dim cutoffDate As New NotesDateTime("Today - 30")
    
    Set db = session.CurrentDatabase
    Set view = db.GetView("AllDocuments")
    Set archiveDb = session.GetDatabase(db.Server, "archive.nsf")
    
    If Not archiveDb.IsOpen Then
        Call archiveDb.Open("", "")
    End If
    
    Set doc = view.GetFirstDocument
    While Not doc Is Nothing
        If doc.Created.TimeDifference(cutoffDate) < 0 Then
            Set archiveDoc = doc.CopyToDatabase(archiveDb)
            Call doc.Remove(True)
        End If
        Set doc = view.GetNextDocument(doc)
    Wend
    
    Messagebox "Архивация завершена!", 64, "Архивация"
End Sub

Sub Initialize
    Dim session As New NotesSession
    Dim db As NotesDatabase
    Dim view As NotesView
    Dim doc As NotesDocument
    Dim nextDoc As NotesDocument
    Dim uniqueIDs As New NotesDocumentCollection
    Dim dupeCount As Integer
    
    Set db = session.CurrentDatabase
    Set view = db.GetView("By Subject") ' Представление, сортированное по теме
    
    Set doc = view.GetFirstDocument
    While Not doc Is Nothing
        Set nextDoc = view.GetNextDocument(doc)
        
        ' Если у следующего документа та же тема, это возможный дубликат
        If Not nextDoc Is Nothing Then
            If doc.GetItemValue("Subject")(0) = nextDoc.GetItemValue("Subject")(0) Then
                ' Проверяем более детально (например, по содержимому)
                If doc.GetItemValue("Body")(0) = nextDoc.GetItemValue("Body")(0) Then
                    Call uniqueIDs.AddDocument(doc) ' Сохраняем оригинал
                    dupeCount = dupeCount + 1
                    Call nextDoc.RemovePermanently(True) ' Удаляем дубликат
                End If
            End If
        End If
        
        Set doc = view.GetNextDocument(doc)
    Wend
    
    Messagebox "Найдено и обработано дубликатов: " & dupeCount, 64, "Обработка дубликатов"
End Sub

Sub Initialize
    Dim session As New NotesSession
    Dim db As NotesDatabase
    Dim view As NotesView
    Dim doc As NotesDocument
    Dim conn As Variant
    Dim rs As Variant
    Dim sql As String
    
    ' Открываем соединение с MSSQL
    Set conn = CreateObject("ADODB.Connection")
    conn.Open "Provider=SQLOLEDB;Data Source=SERVER;Initial Catalog=DB;User ID=user;Password=pass;"
    
    ' Получаем данные из Notes
    Set db = session.CurrentDatabase
    Set view = db.GetView("Orders")
    
    Set doc = view.GetFirstDocument
    While Not doc Is Nothing
        ' Формируем SQL-запрос для вставки данных
        sql = "INSERT INTO Orders (OrderID, Customer, Amount) VALUES ('" & _
              doc.GetItemValue("OrderID")(0) & "', '" & _
              doc.GetItemValue("Customer")(0) & "', " & _
              doc.GetItemValue("Amount")(0) & ")"
        
        ' Выполняем запрос
        conn.Execute sql
        
        ' Помечаем документ как обработанный
        doc.Processed = "1"
        Call doc.Save(True, False)
        
        Set doc = view.GetNextDocument(doc)
    Wend
    
    conn.Close
    Messagebox "Данные успешно экспортированы!", 64, "Экспорт в SQL"
End Sub

Sub Initialize
    Dim session As New NotesSession
    Dim mailDb As NotesDatabase
    Dim inbox As NotesView
    Dim doc As NotesDocument
    Dim sender As String
    Dim subject As String
    
    ' Открываем почтовый ящик
    Set mailDb = session.GetDatabase("", "mail\\username.nsf")
    Set inbox = mailDb.GetView("($Inbox)")
    
    Set doc = inbox.GetFirstDocument
    While Not doc Is Nothing
        ' Получаем отправителя и тему
        sender = doc.GetItemValue("From")(0)
        subject = doc.GetItemValue("Subject")(0)
        
        ' Обрабатываем письмо в зависимости от отправителя
        If Instr(LCase(sender), "boss") > 0 Then
            ' Письмо от руководства — высокий приоритет
            doc.Importance = "1" ' Высокий приоритет
            Call doc.Save(True, False)
        ElseIf Instr(LCase(subject), "отчет") > 0 Then
            ' Письмо с отчетом — перемещаем в специальную папку
            Call doc.PutInFolder("Отчеты")
            Call doc.RemoveFromFolder("($Inbox)")
            Call doc.Save(True, False)
        End If
        
        Set doc = inbox.GetNextDocument(doc)
    Wend
    
    Messagebox "Обработка почты завершена!", 64, "Обработка почты"
End Sub

Sub CreateMeeting(subject As String, location As String, startDate As Variant, duration As Integer, attendees As Variant)
    Dim session As New NotesSession
    Dim mailDb As NotesDatabase
    Dim calmemo As NotesDocument
    
    ' Открываем почтовый ящик
    Set mailDb = session.GetDatabase("", "mail\\username.nsf")
    
    ' Создаем новую встречу
    Set calmemo = mailDb.CreateDocument
    Call calmemo.ReplaceItemValue("Form", "Appointment")
    Call calmemo.ReplaceItemValue("Subject", subject)
    Call calmemo.ReplaceItemValue("Location", location)
    Call calmemo.ReplaceItemValue("StartDate", startDate)
    Call calmemo.ReplaceItemValue("EndDate", AdjustTime(startDate, 0, duration))
    Call calmemo.ReplaceItemValue("AppointmentType", "3") ' 3 = Meeting
    Call calmemo.ReplaceItemValue("RequiredAttendees", attendees)
    
    Call calmemo.Send(False) ' Отправляем приглашение
End Sub
 
Function AdjustTime(dt As NotesDateTime, days As Integer, minutes As Integer) As NotesDateTime
    Dim newDT As New NotesDateTime(dt.DateOnly & " " & dt.TimeOnly)
    Call newDT.AdjustDay(days)
    Call newDT.AdjustMinute(minutes)
    Set AdjustTime = newDT
End Function

Sub Initialize
    Dim i As Integer
    For i = 1 To 10
        Print "Шаг цикла: " & i
        ' Какие-то действия
    Next i
End Sub

Sub LogError(message As String)
    Dim session As New NotesSession
    Dim db As NotesDatabase
    Dim logDoc As NotesDocument
    
    Set db = session.CurrentDatabase
    Set logDoc = db.CreateDocument
    Call logDoc.ReplaceItemValue("Form", "LogEntry")
    Call logDoc.ReplaceItemValue("LogType", "Error")
    Call logDoc.ReplaceItemValue("Message", message)
    Call logDoc.ReplaceItemValue("Timestamp", Now)
    Call logDoc.ReplaceItemValue("User", session.UserName)
    Call logDoc.Save(True, False)
End Sub

Sub Initialize
    On Error Resume Next
    
    ' Какие-то действия
    
    If Err <> 0 Then
        Messagebox "Произошла ошибка: " & Error$ & " (код " & Err & ")", 16, "Ошибка"
        Exit Sub
    End If
    
    On Error Goto 0 ' Отключаем обработку ошибок
End Sub

Sub Initialize
    On Error Goto ErrorHandler
    
    Call PrepareData
    Call ProcessData
    Call FinalizeData
    
    Messagebox "Обработка успешно завершена!", 64, "Успех"
    Exit Sub
    
ErrorHandler:
    Messagebox "Ошибка: " & Error$ & " (код " & Err & ")", 16, "Ошибка"
    Resume Next
End Sub
 
Sub PrepareData
    ' Подготовка данных
End Sub
 
Sub ProcessData
    ' Обработка данных
End Sub
 
Sub FinalizeData
    ' Завершающие действия
End Sub

If somethingUnexpected Then
    Debug ' Остановка для отладки
End If

Sub ExtractAttachments()
    Dim session As New NotesSession
    Dim db As NotesDatabase
    Dim doc As NotesDocument
    Dim attachmentItem As NotesItem
    Dim attachmentObj As NotesEmbeddedObject
    Dim folderPath As String
    
    Set db = session.CurrentDatabase
    Set doc = db.GetDocumentByUNID(session.DocumentUniqueID)
    
    If doc Is Nothing Then
        Messagebox "Документ не найден", 16, "Ошибка"
        Exit Sub
    End If
    
    ' Путь для сохранения вложений
    folderPath = "C:\Attachments\"
    
    ' Получаем объект элемента с вложениями
    Set attachmentItem = doc.GetFirstItem("Attachments")
    
    If attachmentItem Is Nothing Then
        Messagebox "Вложения отсутствуют", 64, "Информация"
        Exit Sub
    End If
    
    ' Перебираем все вложения
    Forall eo In attachmentItem.Values
        Set attachmentObj = eo
        ' Сохраняем вложение
        Call attachmentObj.ExtractFile(folderPath & attachmentObj.Name)
    End Forall
    
    Messagebox "Вложения извлечены в папку: " & folderPath, 64, "Готово"
End Sub

Function IsValidEmail(email As String) As Boolean
    Dim regExp As New NotesRegExp
    
    ' Настраиваем регулярное выражение для проверки email
    regExp.Pattern = "^[a-zA-Z0-9._%+-]+@[a-zA-Z0-9.-]+\.[a-zA-Z]{2,}$"
    regExp.IgnoreCase = True
    
    ' Проверяем соответствие
    IsValidEmail = regExp.Matches(email).Count > 0
End Function

Function FindDocumentsByKeyword(keyword As String) As NotesDocumentCollection
    Dim session As New NotesSession
    Dim db As NotesDatabase
    Dim dc As New NotesDocumentCollection
    Dim view As NotesView
    Dim doc As NotesDocument
    Dim item As NotesItem
    Dim matches As Boolean
    
    Set db = session.CurrentDatabase
    Set view = db.GetView("($All)")
    
    Set doc = view.GetFirstDocument
    While Not doc Is Nothing
        matches = False
        
        ' Проверяем все текстовые поля
        Forall item In doc.Items
            If item.Type = FIELD_TEXT Then
                If Instr(Lcase(item.Text), Lcase(keyword)) > 0 Then
                    matches = True
                    Exit Forall
                End If
            End If
        End Forall
        
        If matches Then
            Call dc.AddDocument(doc)
        End If
        
        Set doc = view.GetNextDocument(doc)
    Wend
    
    Set FindDocumentsByKeyword = dc
End Function

Class TaskManager
    Private notesSession As NotesSession
    Private currentDb As NotesDatabase
    
    Public Sub New()
        Set notesSession = New NotesSession
        Set currentDb = notesSession.CurrentDatabase
    End Sub
    
    Public Function CreateTask(subject As String, assignee As String, dueDate As NotesDateTime) As NotesDocument
        Dim taskDoc As NotesDocument
        
        Set taskDoc = currentDb.CreateDocument
        Call taskDoc.ReplaceItemValue("Form", "Task")
        Call taskDoc.ReplaceItemValue("Subject", subject)
        Call taskDoc.ReplaceItemValue("AssignedTo", assignee)
        Call taskDoc.ReplaceItemValue("DueDate", dueDate)
        Call taskDoc.ReplaceItemValue("Status", "New")
        Call taskDoc.Save(True, False)
        
        Set CreateTask = taskDoc
    End Function
    
    Public Sub CompleteTask(taskID As String)
        Dim taskDoc As NotesDocument
        
        Set taskDoc = currentDb.GetDocumentByUNID(taskID)
        If Not taskDoc Is Nothing Then
            Call taskDoc.ReplaceItemValue("Status", "Completed")
            Call taskDoc.ReplaceItemValue("CompletedDate", New NotesDateTime("Today"))
            Call taskDoc.Save(True, False)
        End If
    End Sub
End Class

Sub Initialize
    Dim start As New NotesDateTime("Today")
    Dim end As New NotesDateTime("Today")
    
    Call start.SetNow()
    ' Здесь размещается код, производительность которого нужно измерить
    Call end.SetNow()
    
    Messagebox "Выполнение заняло " & (end.TimeDifference(start) * 86400) & " секунд", 64, "Профилирование"
End Sub

Function CallRESTAPI(url As String, method As String, payload As String) As String
    Dim httpObj As Variant
    Dim responseText As String
    
    Set httpObj = CreateObject("Microsoft.XMLHTTP")
    Call httpObj.Open(method, url, False)
    Call httpObj.SetRequestHeader("Content-Type", "application/json")
    Call httpObj.Send(payload)
    
    responseText = httpObj.ResponseText
    CallRESTAPI = responseText
End Function

Sub GetWeatherInfo()
    Dim apiKey As String
    Dim city As String
    Dim url As String
    Dim response As String
    Dim jsonParser As Variant
    Dim temperature As Double
    
    apiKey = "ваш_ключ_api"
    city = "Moscow"
    url = "https://api.openweathermap.org/data/2.5/weather?q=" & city & "&appid=" & apiKey & "&units=metric"
    
    response = CallRESTAPI(url, "GET", "")
    
    ' Используем JSON-парсер
    Set jsonParser = CreateObject("ScriptX.JSON")
    jsonParser.Parse(response)
    
    temperature = jsonParser.GetValue("/main/temp")
    
    Messagebox "Температура в " & city & ": " & temperature & "°C", 64, "Погода"
End Sub

Function ExtractJSONValue(json As String, path As String) As String
    Dim startMarker As String
    Dim endMarker As String
    Dim startPos As Long
    Dim endPos As Long
    Dim value As String
    
    startMarker = """" & path & """:"
    startPos = Instr(json, startMarker)
    
    If startPos > 0 Then
        startPos = startPos + Len(startMarker)
        
        ' Проверяем, не строка ли это
        If Mid(json, startPos, 1) = """" Then
            startPos = startPos + 1
            endPos = Instr(startPos, json, """")
        Else
            ' Если не строка, ищем до запятой или скобки
            endPos = Instr(startPos, json, ",")
            Dim bracketPos As Long
            bracketPos = Instr(startPos, json, "}")
            If bracketPos > 0 And (bracketPos < endPos Or endPos = 0) Then
                endPos = bracketPos
            End If
        End If
        
        If endPos > 0 Then
            value = Mid(json, startPos, endPos - startPos)
        End If
    End If
    
    ExtractJSONValue = value
End Function

Sub SendTeamsNotification(webhookUrl As String, message As String, title As String)
    Dim payload As String
    
    payload = "{""@type"":""MessageCard""," & _
              """@context"":""https://schema.org/extensions""," & _
              """themeColor"":""0076D7""," & _
              """title"":""" & title & """," & _
              """text"":""" & message & """}"
    
    Call CallRESTAPI(webhookUrl, "POST", payload)
End Sub

Function UploadToDropbox(accessToken As String, filePath As String, dropboxPath As String) As Boolean
    Dim httpObj As Variant
    Dim fileNum As Integer
    Dim fileData As String
    Dim url As String
    Dim responseText As String
    
    ' Чтение файла
    fileNum = Freefile()
    Open filePath For Binary As fileNum
    fileData = Space$(LOF(fileNum))
    Get fileNum, , fileData
    Close fileNum
    
    ' Загрузка в Dropbox
    Set httpObj = CreateObject("Microsoft.XMLHTTP")
    url = "https://content.dropboxapi.com/2/files/upload"
    
    Call httpObj.Open("POST", url, False)
    Call httpObj.SetRequestHeader("Authorization", "Bearer " & accessToken)
    Call httpObj.SetRequestHeader("Content-Type", "application/octet-stream")
    Call httpObj.SetRequestHeader("Dropbox-API-Arg", "{""path"":""/""" & dropboxPath & """,""mode"":""add"",""autorename"":true}")
    Call httpObj.Send(fileData)
    
    responseText = httpObj.ResponseText
    UploadToDropbox = (httpObj.Status = 200)
End Function

Function AnalyzeTextSentiment(apiKey As String, text As String) As String
    Dim url As String
    Dim payload As String
    Dim response As String
    
    url = "https://api.meaningcloud.com/sentiment-2.1"
    payload = "key=" & apiKey & "&txt=" & UrlEncode(text) & "&lang=ru"
    
    ' Отправляем запрос
    Dim httpObj As Variant
    Set httpObj = CreateObject("Microsoft.XMLHTTP")
    Call httpObj.Open("POST", url, False)
    Call httpObj.SetRequestHeader("Content-Type", "application/x-www-form-urlencoded")
    Call httpObj.Send(payload)
    
    response = httpObj.ResponseText
    
    ' Извлекаем результат
    Dim sentimentScore As String
    sentimentScore = ExtractJSONValue(response, "score_tag")
    
    AnalyzeTextSentiment = sentimentScore
End Function
 
Function UrlEncode(text As String) As String
    Dim i As Integer
    Dim result As String
    Dim char As String
    
    For i = 1 To Len(text)
        char = Mid(text, i, 1)
        If Asc(char) < 32 Or Asc(char) > 127 Then
            result = result & "%" & Hex(Asc(char))
        ElseIf char = " " Then
            result = result & "+"
        ElseIf InStr("ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789-_.~", char) > 0 Then
            result = result & char
        Else
            result = result & "%" & Hex(Asc(char))
        End If
    Next
    
    UrlEncode = result
End Function

Function GetAPIKey(keyName As String) As String
    Dim session As New NotesSession
    Dim db As NotesDatabase
    Dim view As NotesView
    Dim doc As NotesDocument
    
    Set db = session.CurrentDatabase
    Set view = db.GetView("ConfigByKey")
    Set doc = view.GetDocumentByKey(keyName, True)
    
    If Not doc Is Nothing Then
        GetAPIKey = doc.GetItemValue("KeyValue")(0)
    Else
        GetAPIKey = ""
    End If
End Function

Sub Postopen(Source As Notesuidocument)
    Dim browser As Variant
    Set browser = Source.GetEmbeddedObject("WebBrowser1")
    
    ' Загружаем внешнюю страницу
    Call browser.Navigate("http://internal-portal/dashboard")
    
    ' Или генерируем HTML динамически
    Dim html As String
    html = "<html><body><h1>Данные клиента</h1>" & _
           "<p>Название: " & Source.Document.GetItemValue("CompanyName")(0) & "</p>" & _
           "<p>Контакт: " & Source.Document.GetItemValue("ContactName")(0) & "</p>" & _
           "</body></html>"
    
    Call browser.NavigateToContent(html, "text/html")
End Sub

Sub Initialize
  Dim session As New NotesSession
  Dim db As NotesDatabase
  Dim view As NotesView
  Dim doc As NotesDocument
  
  Set db = session.CurrentDatabase
  Set view = db.GetView("AllTasks")
  Set doc = view.GetFirstDocument
  
  While Not doc Is Nothing
    ' Проверка и обработка каждого документа
    If doc.Status(0) = "InProgress" And DateDiff("d", doc.DueDate(0), Now) < 3 Then
      ' Отправка уведомления
      Call SendNotification(doc)
    End If
    
    Set doc = view.GetNextDocument(doc)
  Wend
End Sub

Sub Initialize
  Dim session As New NotesSession
  Dim db As NotesDatabase
  Dim view As NotesView
  Dim collection As NotesDocumentCollection
  
  Set db = session.CurrentDatabase
  
  ' Используем формулу для получения только нужных документов
  Dim formula As String
  formula = "Status = 'InProgress' & @Today - DueDate <= 3 & @Today - DueDate >= 0"
  Set collection = db.Search(formula, Nothing, 0)
  
  ' Теперь обрабатываем только отфильтрованные документы
  Call collection.ForEachDocument(AddressOf ProcessDocument)
End Sub
 
Sub ProcessDocument(doc As NotesDocument)
  Call SendNotification(doc)
End Sub

Sub UpdateDocument(docID As String)
  Dim session As New NotesSession
  Dim db As NotesDatabase
  Dim doc As NotesDocument
  
  Set db = session.CurrentDatabase
  Set doc = db.GetDocumentByID(docID)
  
  doc.Status = "Completed"
  Call doc.Save(True, False)
End Sub

Function UpdateDocument(docID As String) As Integer
  Dim session As New NotesSession
  Dim db As NotesDatabase
  Dim doc As NotesDocument
  Dim lockDoc As NotesDocument
  
  Set db = session.CurrentDatabase
  Set doc = db.GetDocumentByID(docID)
  
  ' Проверяем, не заблокирован ли документ
  Set lockDoc = doc.LockHolders
  If Not lockDoc Is Nothing Then
    ' Документ заблокирован, возвращаем код ошибки
    UpdateDocument = 1
    Exit Function
  End If
  
  ' Документ не заблокирован, обновляем
  doc.Status = "Completed"
  
  On Error Resume Next
  Call doc.Save(True, False)
  If Err <> 0 Then
    ' Ошибка при сохранении
    UpdateDocument = 2
    Exit Function
  End If
  
  UpdateDocument = 0 ' Успешное обновление
End Function

Sub CreateSecureDocument(subject As String, body As String, readers As Variant)
  Dim session As New NotesSession
  Dim db As NotesDatabase
  Dim doc As NotesDocument
  
  Set db = session.CurrentDatabase
  Set doc = db.CreateDocument
  
  Call doc.ReplaceItemValue("Form", "SecureNote")
  Call doc.ReplaceItemValue("Subject", subject)
  Call doc.ReplaceItemValue("Body", body)
  
  ' Создаём поле Reader для контроля доступа
  Dim readersItem As New NotesItem(doc, "ReadAccess", readers, NAMES)
  readersItem.IsReaders = True
  
  Call doc.Save(True, False)
End Sub

Function ExportToCSV(viewName As String, filePath As String) As Integer
  Dim session As New NotesSession
  Dim db As NotesDatabase
  Dim view As NotesView
  Dim doc As NotesDocument
  Dim fileNum As Integer
  Dim line As String
  Dim i As Integer
  
  Set db = session.CurrentDatabase
  Set view = db.GetView(viewName)
  
  fileNum = FreeFile()
  Open filePath For Output As fileNum
  
  ' Записываем BOM для UTF-8
  Print #fileNum, Chr$(239) & Chr$(187) & Chr$(191);
  
  ' Записываем заголовки
  line = ""
  For i = 0 To view.ColumnCount - 1
    If i > 0 Then line = line & ";"
    line = line & """" & view.ColumnNames(i) & """"
  Next
  Print #fileNum, line
  
  ' Записываем данные
  Set doc = view.GetFirstDocument
  While Not doc Is Nothing
    line = ""
    For i = 0 To view.ColumnCount - 1
      If i > 0 Then line = line & ";"
      ' Обработка значения ячейки
      Dim value As String
      value = view.GetColumnValues(i, doc)(0)
      ' Экранируем кавычки
      value = Replace(value, """", """""")
      line = line & """" & value & """"
    Next
    Print #fileNum, line
    Set doc = view.GetNextDocument(doc)
  Wend
  
  Close fileNum
  ExportToCSV = 0
End Function

Sub Initialize
  Dim session As New NotesSession
  Dim doc As NotesDocument
  Dim amount As Double
  Dim department As String
  Dim nextApprover As String
  
  Set doc = session.DocumentContext
  amount = CDbl(doc.GetItemValue("Amount")(0))
  department = doc.GetItemValue("Department")(0)
  
  ' Определяем следующего согласующего на основе суммы и отдела
  If amount <= 50000 Then
      ' До 50 тыс. согласует руководитель отдела
      nextApprover = GetDepartmentHead(department)
  ElseIf amount <= 500000 Then
      ' До 500 тыс. согласует финдиректор
      nextApprover = "CN=Financial Director/O=Company"
  Else
      ' Свыше 500 тыс. согласует генеральный директор
      nextApprover = "CN=CEO/O=Company"
  End If
  
  Call doc.ReplaceItemValue("NextApprover", nextApprover)
  Call doc.ReplaceItemValue("Status", "Pending Approval")
  Call doc.Save(True, False)
  
  ' Отправляем уведомление следующему согласующему
  Call SendNotificationToApprover(nextApprover, doc)
End Sub

Function GetActualApprover(approverName As String) As String
  Dim session As New NotesSession
  Dim db As NotesDatabase
  Dim view As NotesView
  Dim subDoc As NotesDocument
  Dim today As New NotesDateTime("Today")
  
  ' Открываем базу замещений
  Set db = session.GetDatabase(session.CurrentDatabase.Server, "substitutions.nsf")
  Set view = db.GetView("ByApprover")
  
  ' Ищем актуальное замещение
  Set subDoc = view.GetDocumentByKey(approverName, True)
  
  ' Если найдено замещение и оно действует сегодня
  If Not subDoc Is Nothing Then
      If subDoc.StartDate(0) <= today.LSLocalTime And subDoc.EndDate(0) >= today.LSLocalTime Then
          GetActualApprover = subDoc.Substitute(0)
          Exit Function
      End If
  End If
  
  ' Если замещения нет, возвращаем исходного согласующего
  GetActualApprover = approverName
End Function

Sub FetchDataFromOracle()
  Dim session As New NotesSession
  Dim db As NotesDatabase
  Dim doc As NotesDocument
  Dim conn As Object
  Dim rs As Object
  Dim sql As String
  
  Set db = session.CurrentDatabase
  
  ' Создаем соединение с Oracle
  Set conn = CreateObject("ADODB.Connection")
  conn.ConnectionString = "Provider=OraOLEDB.Oracle;Data Source=FINDB;User ID=reporter;Password=[B][/B]*;"
  conn.Open
  
  ' Выполняем SQL-запрос
  sql = "SELECT branch_id, product_id, SUM(amount) as total_amount " & _
        "FROM transactions " & _
        "WHERE trx_date BETWEEN TRUNC(ADD_MONTHS(SYSDATE, -1), 'MM') " & _
        "AND TRUNC(SYSDATE, 'MM') - 1 " & _
        "GROUP BY branch_id, product_id"
  
  Set rs = conn.Execute(sql)
  
  ' Обрабатываем результаты
  While Not rs.EOF
    Set doc = db.CreateDocument
    Call doc.ReplaceItemValue("Form", "TransactionData")
    Call doc.ReplaceItemValue("DataSource", "Oracle")
    Call doc.ReplaceItemValue("BranchID", rs.Fields("branch_id").Value)
    Call doc.ReplaceItemValue("ProductID", rs.Fields("product_id").Value)
    Call doc.ReplaceItemValue("Amount", rs.Fields("total_amount").Value)
    Call doc.ReplaceItemValue("ImportDate", Now)
    Call doc.Save(True, False)
    
    rs.MoveNext
  Wend
  
  rs.Close
  conn.Close
End Sub

Sub NotifySlack(message As String, channel As String)
  Dim httpObj As Variant
  Dim payload As String
  Dim webhookUrl As String
  
  webhookUrl = GetConfigValue("SlackWebhookURL") 
  
  payload = "{""channel"": ""#" & channel & """, ""text"": """ & message & """, ""username"": ""Notes Bot"", ""icon_emoji"": "":memo:""}"
  
  Set httpObj = CreateObject("Microsoft.XMLHTTP")
  Call httpObj.Open("POST", webhookUrl, False)
  Call httpObj.setRequestHeader("Content-Type", "application/json")
  Call httpObj.Send(payload)
End Sub