NotesDocumentArray
While working on a R4.6 application I needed a flexible document container
that would allow me to add and remove documents on an ad hoc basis, sort
the documents based on an item value. So here's my solution: The NotesDocumentArray
class.
Description:
With it you can:
- add and remove individual documents and add document collections
- sort by an item value
- set an item value across all documents in the array
- remove documents from the array where item = value
- merge document arrays together
- It also has standard NotesDocumentCollection methods like GetFirstDocument, GetNthDocument(x) and GetNextDocument(doc)
Some of the functionality of this class can be recreated manually with an array of NotesDocuments but then you have to worry about Redimming and all that hassle, which is boring. Use the NotesDocumentArray class and you can just call the AddDocument method or the AddCollection method and the class worries about all that for you and you get a bunch of other cool methods to boot! Doesn't that sound good?
Please read the description in the code comments as well.
I mentioned ND 4.6 but it's also usful in R5. For example you can't dim a NotesDocumentCollection the call AddDocument to add the first document; the collection already has to contain something. This is annoying if you don't want it to contain anything! The NotesDocumentArray is initialised as empty, ready for you to start adding stuff.
Properties and Methods
here's a complete list:
Public Property Get Count As Integer
'// Returns the number of documents in the array
Public Property Get IsSorted As Integer
'// Returns true or false if the array has been sorted
Public Property Get SortedBy As String
'// Returns the item name by which the array was sorted
Public Property Get GetFirstDocument As NotesDocument
'// Returns first document in array
Public Property Get GetLastDocument As NotesDocumenty
'// Returns last document in array
Public Property Get GetNthDocument(x As Integer) As NotesDocument
'// Returns document at index
Public Property Get GetDocumentIndex(doc As NotesDocument) As Integer
'// Returns document index number or 0 if not found
Public Property Get GetNextDocument(doc As NotesDocument) As NotesDocument
'// Returns next document sfter supplied docs index otherwise nothing if there's no next doc
Public Property Get GetPrevDocument(doc As NotesDocument) As NotesDocument
'// Returns previous document before supplied docs index otherwise nothing if there's no prev doc
Public Sub New ()
'// Class New constructor
Public Sub Reset()
'// resets the doc array to empty
Public Sub AddArray(array2 As NotesDocumentArray)
'// Add another notes document array to the array
Public Sub AddCollection(dc As NotesDocumentCollection)
'// Add a notes document collection to the array
Public Sub AddDocument(doc As NotesDocument)
'// Add a document to the array
Public Sub RemoveDocument(doc As NotesDocument)
'// Remove a document from the array
Public Sub RemoveMatchingDocuments(itemname As String, text As String)
'// Removes all documents where item.text = text
Public Sub SortBy(itemname As String)
'// Sorts documents by the value contained in the item specified by item name
Public Sub SetFieldValue(itemname As String,itemvalue As Variant)
'// sets a specified field to a specified value in all docs in array
Status
This is still a beta version so any suggestions/comments/corrections/additions are most welcome
%REM ....................................CLASS Information:
NotesDocumentArray
'Version: 0.8.7.0
(beta) 10/12/2001
'Created: By Andrew Tetlaw
'Creation Date: 03 Sep 2001
'PURPOSE: A more flexible document collection container than a document
collection.
'The class gets around limitations in the R4 NotesDocumentCollection. With
DocArray
'you can add document collections or add one document at a time to the
array. It also
'has most of the methods and properties of the NotesDocumentCollection
class with a
'few extras like SortBy and GetDocumentIndex.
'Re: Error handling: I just want it to ignore problems like a good little
class and
'instead do nothing. For example if a function requires a NotesDocument
as an argument
'and Nothing is passed (indicating a problem) the function just doesn't
do anything
'rather than throwing an exception and messing up what ever routine called
the class.
'This means that error checking must be done in the calling function.
'Based on work done by:
' Micheal Werry for the class idea and the AddCollection method
' Slade Swan for the bubble sort routine in the SortBy method
'contributions from:
' Tony Harrison: 'Sub KeepMatchingDocuments(itemname As String, text
As String)'
%END REM
Class NotesDocumentArray
'## ===== PROPERTIES ==== ##
Public Array() As NotesDocument
Private Index As Integer
Private Srtd As Integer
Private SrtdBy As String
Public Property Get Count As Integer
Count = Me.Index
End Property
Public Property Get IsSorted As Integer
IsSorted = Me.Srtd
End Property
Public Property Get SortedBy As String
SortedBy = Me.SrtdBy
End Property
'// Returns first document in array
Public Property Get GetFirstDocument As NotesDocument
If Me.Index > 0 Then
Set GetFirstDocument
= Me.Array(Lbound(Me.Array))
Else
Set GetFirstDocument
= Nothing
End If
End Property
'// Returns last document in array
Public Property Get GetLastDocument As NotesDocument
If Me.Index > 0 Then
Set GetLastDocument =
Me.Array(Ubound(Me.Array ))
Else
Set GetLastDocument =
Nothing
End If
End Property
'// Returns document at index
Public Property Get GetNthDocument(x As Integer) As NotesDocument
If (x > 0) And (Me.Index >= x)
Then
Set GetNthDocument =
Me.Array(x-1)
Else
Set GetNthDocument =
Nothing
End If
End Property
'// Returns document index number or 0 if not found
Public Property Get GetDocumentIndex(doc As NotesDocument)
As Integer
Dim x As Integer
If Not (doc Is Nothing) Then '// Don't
do anything for nothing!
For x = 1 To (Me.Index)
If
Me.Array(x-1).UniversalID = doc.UniversalID Then
GetDocumentIndex = x
End
If
Next
End If
End Property
'// Returns next document sfter supplied docs index otherwise
nothing if there's no next doc
Public Property Get GetNextDocument(doc As NotesDocument)
As NotesDocument
Dim x As Integer
If Not (doc Is Nothing) Then '// Don't
do anything for nothing!
For x = 0 To Ubound(Me.Array)
If
Me.Array(x).UniversalID = doc.UniversalID Then
If Ubound(Me.Array) > x Then
Set GetNextDocument = Me.Array(x+1)
End If
End
If
Next
End If
End Property
'// Returns previous document before supplied docs index
otherwise nothing if there's no prev doc
Public Property Get GetPrevDocument(doc As NotesDocument)
As NotesDocument
Dim x As Integer
If Not (doc Is Nothing) Then '// Don't
do anything for nothing!
For x = 0 To (Me.Index-1)
If
Me.Array(x).UniversalID = doc.UniversalID Then
If Lbound(Me.Array) >= x-1 Then
Set GetPrevDocument = Me.Array(x-1)
End If
End
If
Next
End If
End Property
'## ==== NEW ==== ##
'// Class New constructor
Public Sub New ()
Redim Me.Array(0)
Me.Index = 0
Me.Srtd = False
Me.SrtdBy = ""
End Sub
'## ==== Reset ==== ##
'// resets the doc array to empty
Public Sub Reset()
Redim Me.Array(0)
Me.Index = 0
Me.Srtd = False
Me.SrtdBy = ""
End Sub
'## ==== ADD DOCUMENT ARRAY ==== ##
'// Add another notes document array to the array
Public Sub AddArray(array2 As NotesDocumentArray)
If Not (array2 Is Nothing) Then '//
Don't do anything for nothing!
If array2.Count >
0 Then '// Don't do anything if the array is empty!
Redim
Preserve Me.Array(Me.Index + array2.Count -1)
Dim
doc As NotesDocument
Dim
x As Integer
For
x = 1 To array2.Count
Set Me.Array(Me.Index + (x-1)) = array2.GetNthDocument(x)
Next
Me.Index
= Me.Index + array2.Count
End If
End If
End Sub
'## ==== ADD DOCUMENT COLLECTION ==== ##
'// Add a notes document collection to the array
Public Sub AddCollection(dc As NotesDocumentCollection)
If Not (dc Is Nothing) Then '// Don't
do anything for nothing!
If dc.Count > 0 Then
'// don't add anything if the DC is empty!
Redim
Preserve Me.Array( Me.Index + dc.Count -1)
Dim
doc As NotesDocument
Dim
x As Integer
For
x = 1 To dc.Count
Set Me.Array(Me.Index + (x-1)) = dc.GetNthDocument(x)
Next
Me.Index
= Me.Index + dc.Count
End If
End If
End Sub
'## ==== ADD DOCUMENT ==== ##
'// Add a document to the array
Public Sub AddDocument(doc As NotesDocument)
If Not (doc Is Nothing) Then '// Don't
do anything for nothing!
Redim Preserve Me.Array
(Me.Index) '// Me.Index will always be 1 above the ubound anyway so you
don't need to +1
Set Me.Array(Me.Index)
= doc
Me.Index = Me.Index +
1
End If
End Sub
'## ==== REMOVE DOCUMENT ==== ##
'// Remove a document from the array
Public Sub RemoveDocument(doc As NotesDocument)
Dim x As Integer
Dim y As Integer
Dim newArray() As NotesDocument
Dim sortfield As String
Dim dosort As Integer
If Not (doc Is Nothing) Then '// Don't
do anything for nothing!
Redim newArray(0) '//
Initialise
'// make a new array
of documents excluding the one to remove
For x = 0 To (Me.Index-1)
If
Not ( Me.Array(x).UniversalID = doc.UniversalID) Then
Redim Preserve newArray(y)
Set newArray(y) = Me.Array(x)
y=y+1
End
If
Next
'// reset the NotesDocumentArray
and rebuild it from the new array of documents created above
'Didn't want to use Reset()
because I didn't want to interfere with the sorting properties
Redim Me.Array(0)
Me.Index = 0
For x = 0 To Ubound(newArray)
Call
Me.AddDocument(newArray(x))
Next
End If
End Sub
'## ==== REMOVE MATCHING DOCUMENTS ==== ##
'// Removes all document where item.text = text
Public Sub RemoveMatchingDocuments(itemname As String, text
As String)
Dim x As Integer
Dim y As Integer
Dim newArray() As NotesDocument
Dim doc As NotesDocument
Dim item As NotesItem
Redim newArray(0) '// Initialise
'// make a new array
of documents excluding the one to remove
For x = 0 To (Me.Index-1)
Set doc = Me.Array(x)
If Not (doc Is Nothing)
Then
Set
item = doc.GetFirstItem(itemname)
If
Not (item Is Nothing) Then
If Not (item.Text = text) Then
Redim Preserve newArray(y)
Set newArray(y) = doc
y=y+1
End If
End
If
End If
Next
'// reset the NotesDocumentArray
and rebuild it from the new array of documents created above
'Didn't want to use Reset()
because I didn't want to interfere with the sorting properties
Redim Me.Array(0)
Me.Index = 0
For x = 0 To Ubound(newArray)
Call Me.AddDocument(newArray(x))
Next
End Sub
'## === KEEP MATCHING DOCUMENTS ==== ##
Public Sub KeepMatchingDocuments(itemname As String,
text As String)
Dim x As Integer
Dim y As Integer
Dim newArray() As NotesDocument
Dim doc As NotesDocument
Dim item As NotesItem
Redim newArray(0) '// Initialise
'// make a new array
of documents excluding the one to remove
For x = 0 To (Me.Index-1)
Set doc = Me.Array(x)
If Not (doc Is Nothing)
Then
Set
item = doc.GetFirstItem(itemname)
If
Not (item Is Nothing) Then
If (item.Text = text) Then
Redim Preserve newArray(y)
Set newArray(y) = doc
y=y+1
End If
End
If
End If
Next
Redim Me.Array(0)
Me.Index = 0
For x = 0 To Ubound(newArray)
Call Me.AddDocument(newArray(x))
Next
End Sub
'## ==== SORT BY ==== ##
Public Sub SortBy(itemname As String)
Dim doc As NotesDocument
Dim doc1 As NotesDocument
Dim j As Integer
Dim i As Integer
Dim a As Variant
Dim b As Variant
Dim lngA As Long
Dim lngB As Long
Dim swap As Integer
'// Bubble sort
If Me.Index > 0 Then
For i=1 To (Me.Index-1)
'// Outer loop for sort
j=i
Do
While j>=1 '// Inner loop for sort
b = Me.Array(j).GetItemValue(itemname) '// i.e. order val
of 2nd doc in pair
a = Me.Array(j-1).GetItemValue(itemname)'// i.e. i.e. order
val of 1st doc in pair
If b(0)
Set doc=Me.Array(j)
Set doc1=Me.Array(j-1)
Set Me.Array(j)=doc1
Set Me.Array (j-1)=doc
j=j-1 '// decrement so that previous
2nd doc be comes 1st: that is you compare 1 and 0, then 2 and 1, then 3
and 2...and so on
Else
Exit Do
End If
Loop
Next
Me.Srtd = True
Me.SrtdBy = itemname
End If
End Sub
'## ==== SET FIELD VALUE ==== ##
'// sets a specified field to a specified value in all docs
in array
Public Sub SetFieldValue(itemname As String,itemvalue As
Variant)
Dim doc As NotesDocument
Dim x As Integer
For x = 0 To (Me.Index-1)
Set doc = Me.Array(x)
If Not (doc Is Nothing)
Then '// don't want to generate any errors.
Call
doc.ReplaceItemValue(itemname,itemvalue)
Call
doc.save(True,True)
End If
Next
End Sub
End Class
Fabio Barbieri
0 Commenti:
Nessun Commento Trovato