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
Tags: Excel, Export to XLS, Lotus, script
Lotus Script | maxim 16.10.2015