Экспорт в CSV - все документы в коллекции с отсортированными элементами
Любой, кто использовал плохо спроектированную / поддерживаемую базу данных лотосных заметок, может засвидетельствовать, что не все записи с одинаковым именем формы имеют одинаковое количество элементов или даже порядок элементов.
Возникла необходимость экспортировать всю базу данных в CSV-файлы для миграции, и я собирал кусочки из разных форумов и блогов, чтобы добиться этого.
У меня есть рабочая модель кода, но она требует ручного редактирования для создания коллекции для каждой формы. Что хорошо, но не так аккуратно, как хотелось бы.
Кто-нибудь знает способ динамического создания новой коллекции на основе данных, извлеченных из основной коллекции / записи.
Весь кодовый набор ниже
'Whole database export via collection with Sorted items, created by CodeJack
'Export CSV based on http://searchdomino.techtarget.com/tip/How-to-export-data-from-a-Lotus-Notes-database-to-a-CSV-file
'sortValues based on http://per.lausten.dk/domino/sortNotesDocumentCollection.html
Sub Initialize
On Error Goto processerror
Dim session As New NotesSession
Dim dbPri As NotesDatabase
Dim ws As New NotesUIWorkspace
Dim dc As NotesDocumentCollection
Dim docPri As NotesDocument
Dim curView As NotesUIView
Dim NumRec As String
Dim msgOutputs As String
'Get useable date and time values for file naming
Dim fDate As String
Dim fTime As String
If Month(Date()) < 10 Then
If Day(Date()) < 10 Then
fDate = Year(Date()) & "0" & Month(Date()) & "0" & Day(Date())
Else
fDate = Year(Date()) & "0" & Month(Date()) & Day(Date())
End If
Else
If Day(Date()) < 10 Then
fDate = Year(Date()) & Month(Date()) & "0" & Day(Date())
Else
fDate = Year(Date()) & Month(Date()) & Day(Date())
End If
End If
fTime = Hour(Time()) & "-" & Minute(Time())
'Set the NewLine variable for breaking message boxes
Dim NewLine As String
NewLine = Chr(10)+Chr(13)
'declare the Pri database
Set dbPri = session.CurrentDatabase
Set curView = ws.CurrentView
'Set the Primary DB collection to retrieve the list of selected documents in the view
Set dc = curView.Documents
'Collection1s collection
Dim dcCollection1 As NotesDocumentCollection
Dim docCollection1 As NotesDocument
Dim NumCollection1 As String
'Collection2 collection
Dim dcCollection2 As NotesDocumentCollection
Dim docCollection2 As NotesDocument
Dim NumCollection2 As String
'Open collections
If dbPri.IsOpen Then
Set dcCollection1 = dbPri.CreateDocumentCollection
Set dcCollection2 = dbPri.CreateDocumentCollection
Else
Msgbox "Database has not been opened"
Exit Sub
End If
'Set Export path
Dim sFilepath As String
Dim sFilename As String
sFilepath = "C:\Data\Testing\"
'Continue if collection has documents
NumRec = dc.Count
If NumRec > 0 Then
msgOutputs = NumRec & " records processed." & NewLine
'Split out documents to their individual Collections
If (Not dc Is Nothing) Then
For a = 1 To dc.Count 'a = all documents
Set docPri = dc.GetNthDocument(a)
'Assign document to relevant collection based on the form name
If docPri.Form(0) = "VID" Then
Call dcCollection1.AddDocument (docPri)
Elseif docPri.Form(0) = "SI" Then
Call dcCollection2.AddDocument (docPri)
End If
Next
End If
Else
Msgbox "No records in collection"
Exit Sub
End If
'Process Collection1
'Count # of records in collection
NumCollection1 = dcCollection1.Count
'Continue if collection has documents
If NumCollection1 > 0 Then
'Compile output message
msgOutputs = msgOutputs & NumCollection1 & " - " & dcCollection1.GetFirstDocument.Form(0) & "'s" & NewLine
'Set the export filename
sFilename = dcCollection1.GetFirstDocument.Form(0) & "_" & fDate &"_" & fTime & ".csv"
'Export Collection
Call exportCSV(dcCollection1, sFilepath, sFilename)
End If
'Process Collection2
NumCollection2 = dcCollection2.Count
'Continue if collection has documents
If NumCollection2 > 0 Then
'Compile output message
msgOutputs = msgOutputs & NumCollection2 & " - " & dcCollection2.GetFirstDocument.Form(0) & "'s" & NewLine
'Set the export filename
sFilename = dcCollection2.GetFirstDocument.Form(0) & "_" & fDate &"_" & fTime & ".csv"
'Export Collection
Call exportCSV(dcCollection2, sFilepath, sFilename)
End If
'Display output message to user
Msgbox msgOutputs
Exit Sub
processerror:
If Err <> 0 Then
Msgbox "Initialize: ERROR on line " & Cstr(Erl) & " (" & Cstr(Err) & ") - " & Error$
Exit Sub
End If
End Sub
Sub exportCSV(col As NotesDocumentCollection, sFilepath As String, sFilename As String)
'CSV write method based on http://searchdomino.techtarget.com/tip/How-to-export-data-from-a-Lotus-Notes-database-to-a-CSV-file
'Altered by Andrew Lambert to fit purpose of sorting and exporting all items on documents in a collection
On Error Goto processerror
Dim datadoc As NotesDocument
Dim sorteddoc As NotesDocument
Dim db As NotesDatabase
Dim session As New NotesSession
Dim fileNum As Integer
Dim fileName As String
Dim headerstring As String
Dim values As String
Dim item As NotesItem
Dim ItemName As String
Dim arSort As Variant
Set db = session.CurrentDatabase
fileNum% = Freefile()
fileName$ = sFilepath & sFilename
Open fileName$ For Output As fileNum%
'Build Files
If (Not col Is Nothing) Then
For i = 1 To col.Count
Set datadoc = col.GetNthDocument(i)
'Write record header to file
Forall x In datadoc.Items
If x.type = 1084 Or x.name = "Photograph" Or x.name = "Signature" Then 'Skip data types / fields which cant be exported via CSV
'Do nothing
Else
headerstring=headerstring & |"| & x.name &|",| 'Create header string for the record
End If
End Forall
'remove trailing comma
headerstring=Left(headerstring,Len(headerstring)-1)
'break headerstring into components for array
arSort = Split(headerstring,",")
'Sort array alphabetically
arSort = sortValues(arSort)
'Compile sorted array back into string
headerstring = Implode(arSort,",")
'remove trailing "
headerstring=Left(headerstring,Len(headerstring)-1)
'Write to file
Write #fileNum%, |Header","UNID",| & headerstring & ||
headerstring=""
'Create sorted document for exporting data, this is needed as you can't sort the values of the items separate from the item names
Set sorteddoc = db.CreateDocument
'Loop through sorted array of item names
Forall z In arSort
ItemName = Replace(z,|"|,||) 'Remove quotations to avoid ADT error
'Copy item from source document to destination in alphabetical order
Call sorteddoc.CopyItem(datadoc.GetFirstItem(ItemName),ItemName)
End Forall
'Write record data to file
'loop through all document items
Forall x In sorteddoc.Items
'retrieve item value
values=values & |"| & x.text &|",|
End Forall
'Write to file
Write #fileNum%, |Data",| & |"| & sorteddoc.UniversalID & |",| & values & |"|
values=""
Next
End If
Close fileNum%
Exit Sub
processerror:
If Err <> 0 Then
Msgbox "Export CSV: ERROR on line " & Cstr(Erl) & " (" & Cstr(Err) & ") - " & Error$
Exit Sub
End If
End Sub
Function sortValues(varValues As Variant) As Variant
'from http://per.lausten.dk/domino/sortNotesDocumentCollection.html
On Error Goto errHandler
' Use Shell sort to sort input array and return array sorted ascending
Dim k As Integer
Dim i As Integer
Dim j As Integer
Dim h As Integer
Dim r As Integer
Dim temp As String
'Set up for Shell sort algorithm
k = Ubound( varValues )
h = 1
Do While h < k
h = (h*3)+1
Loop
h = (h-1)/3
If h > 3 Then
h = (h-1)/3
End If
'Shell sort algorithm
Do While h > 0
For i = 1+h To k
temp = varValues(i)
j = i-h
Do While j >0
If varValues(j)>temp Then
varValues(j+h) = varValues(j)
varValues(j) = temp
Else
Exit Do
End If
j = j-h
Loop
Next i
h = (h-1)/3
Loop
'Write new sorted values
sortValues = varValues
getOut:
Exit Function
errHandler:
Dim strMsg As String
strMsg = "SortValues: Error #" & Err & Chr$(10) & Error$ & Chr$(10) & "Line #" & Erl & | in sub/function: "| & Lsi_info(2) & |"|
Msgbox strMsg, 16, "Unexpected error"
sortValues = "ERROR"
Resume getOut
End Function
1 ответ
Прежде всего: не используйте GetNthDocument в NotesDocumentCollections, это делает вещи невероятно медленными, так как отсчитывает от 0 в каждом раунде... Время увеличивается экспоненциально с увеличением размера коллекции.
Вместо
For i = 1 to dc.Count
Set doc = dc.GetNthDocument(i)
Next
использование
Set doc = dc.GetFirstDocument()
While not doc is Nothing
'- do your stuff here
Set doc = dc.GetNextDocument(doc)
Wend
Тем не менее, существуют разные способы создания коллекций.
Я бы предложил использовать список коллекций, чтобы быть полностью гибким:
Dim ldc List as NotesDocumentCollection
Если у вас есть имя форм, которые вы хотите экспортировать в массив (varForms в примере), то вы можете сделать что-то вроде этого:
Forall strForm in varForms
Set ldc( strForm ) = dbPri.Search( {Form = "} & strForm & {"}, Nothing, 0)
End Forall
Как указано в комментарии Ричарда (спасибо), вы можете просто получить все формы в базе данных, используя
varForms = dbPri.Forms
Таким образом, вам не нужно представление, содержащее все документы, которые вы хотите экспортировать.
Если вы хотите "разделить" существующую коллекцию (как в вашем примере), вы можете сделать что-то вроде этого:
Set doc = dc.GetFirstDocument()
While not doc is Nothing
strForm = doc.GetitemValue( "form" )(0)
If Not iselement( ldc( strForm ) ) then
Set ldc( strForm ) = dbPri.CreateDocumentCollection
End If
Call ldc(strForm).AddDocument( doc )
Set doc = dc.GetNextDocument(doc)
Wend
А позже вы можете запустить все коллекции:
Forall dcForm in ldc
Set docWork = dcForm.GetFirstDocument()
While not docWork is Nothing
'- do your stuff here
Set docWork = dcForm.GetNextDocument(docWork)
Wend
End Forall
Надеюсь, что это даст вам отправную точку