Export Lotus To Excel

Как-то встал передо мной вопрос экспорта документов из Lotus Notes в данные формата, с которым могут работать обычные пользователи. Ничего лучше Excel‘я я не нашел. В принципе, можно было создать представление и из него сразу экспортнуть всю инфу в Excel, но в данных, которые нужны пользователям, необходимо было также добавлять связанные данные из другой базы. Мог-бы помочь @DbLookup, но, как известно, в столбцах представлений @DbLookup не работает (!!!).
Поэтому пришлось гуглить и кастомизировать полученные результаты поиска под свои задачи.

Исходные данные: есть 2 базы. В одной базе хранятся логины пользователей (одной из внутренних систем), в другой базе — электронные адреса этих пользователей. Нужен на выходе список, чтобы каждому логину был сопоставлен e-mail. Данные в двух базах связаны по табельному номеру пользователя.
В Лотусе никаких дополнительных библиотек подключать не нужно. Стандартного функционала языка Lotus Script хватает.
Странно, что описания интеграции Лотуса с Excel-ем в стандартной документации Lotus Designer’а я так и не нашел.

Код будет обрабатывать программный агент.
В настройках агента Basics в блоке Runtime Trigger->OnEvent->Action menu selection; Target->None.


Sub Initialize
  On Error GoTo er
  Dim exStr As String
  exStr = ""
  Dim ss As NotesSession
  Dim dbUsers As NotesDatabase
  Set dbUser = ss.CurrentDatabase ' Текущая база, в которой живет програмный агент,
  ' и из которой берем список пользователей с логинами.
  Dim viewUsers As NotesView
  Set viewUsers = dbUsers.GetView("<our VIEW in DB with list of Users>")
  Dim docUsers As NotesDocument
  Set docUsers = viewUsers.GetFirstDocument

  Dim dbPhone As NotesDatabase ' база с e-mail'ами - (телефонная)
  Set dbPhone = ss.GetDatabase({<server Name>},{<db Name>})
  If Not dbPhone.IsOpen Then
   exStr$ = {Not Find Database}
   GoTo ex
  End If
  Dim viewPhone As NotesView
  Set viewPhone = dbPhone.GetView({<View>}) ' представление в телефонной базе, со списком документов.
  ' Документы в представлении отсортированы по ключевому полю с табельным номером пользователя в порядке возрастания.
  Dim docPhone As NotesDocument

  Dim U_Login As String
  Dim U_Email As String
  Dim U_TabNo As String
  Dim i As Integer
  i = 1

  Dim xlApp As Variant, lxsheet As Variant, xlwb As Variant, xlrange As Variant
  Dim filename As String
  Dim batchRows As Integer
  Dim totalColumns As Integer
  Dim timer1 As Long, timer2 As Long
  timer1 = Timer
  filename = "c:\111.xls" ' предполагаемое место, где должен находиться пустой xls файл для наполнения.
  ' Файл должен там быть !!!
  batchRows = 10000 ' количество строк. Берем с запасом, чтобы не было переполнения.
  ' Если предполагается, что строк будет больше, то ставим большее число.
  totalColumns = 2 ' количество колонок. У нас строго будет 2 колонки.

  Set xlApp = CreateObject("Excel.Application")
  xlApp.Visible = True ' Определяем, будет ли приложение Excel запускаться в фоне или нет.
  Set xlwb = xlApp.Workbooks.Open(filename)
  Set xlsheet = xlwb.Worksheets(1)

  Dim DataArray
  DataArray = xlsheet.Range("A1").Resize(batchRows,250).Value ' Задаем область на листе приложения Excel

  While Not docUsers Is Nothing
   U_Login = docUsers.LoginName(0)
   U_TabNo = docUsers.TabNum(0)
   ' Находим по табельному номеру этого пользователя в телефонной базе
   Set docPhone = viewPhone.GetDocumentByKey(CStr(U_TabNo),True)
   If Not docPhone Is Nothing Then
    U_Email = docPhone.EmailAddress(0)
    DataArray(i, 1) = U_Login
    DataArray(i, 2) = U_Email
    i = i+1
   End If
   Set docUsers = viewUsers.GetNextDocument(docUsers)
  Wend
  xlsheet.Range("A1").Resize(i+1,2).Value = DataArray
  GoTo ex

er:
  Print {Agent_User_Login_Email_To_XLS }, Err & {: } & Error$, {in } & Erl
  Goto ex
ex:
  Print exStr
  timer2 = Timer
  ' Call xlAppQuit() ' Если надо закрывать приложение Excel после завершения работы агента.
  ' Но в этом случае все равно будет предложено сохранить изменения в документе.
  Print "Done in " + CStr(timer2 - timer1) + " seconds. " + Chr(10)+Chr(13)+"Export in "+CStr(i-1)+" records."

End Sub

Comments are closed.