導出為CSV-集合中所有包含分類項目的文檔

Question

任何使用過設計/維護不佳的Lotus Notes數據庫的人都可以證明，並非所有具有相同表單名稱的記錄都具有相同的項數，甚至項的順序。

出於將整個數據庫導出到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

Answer 1

首先：不要在NotesDocumentCollections上使用GetNthDocument，它會使事情變得異常緩慢，因為它每輪都從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

正如Richard（thanx）的評論中所述，您可以通過使用以下命令簡單地獲取數據庫中的所有表單

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

希望能給您一個起點