An alternative to the collection object is the scripting.Dictionary object which you can find adding a reference to the Microsoft Scripting Runtime.
The Dictionary Object is an Hash Table, so it is preferred to the Collection object when you need to access elements in the collection by key.
In addtion it has few properties and methods that the Collection object is lacking.
Keys() returns all the keys as an array
Items() returns all the Items as an array
Exists(key): returns true if a key is in the dictionary.
The major draw back is that it does not have an enumerator so you cannot do something like
for Each v in objDictionary
'Do Something
End
Fortunately there is a work around. You can loop the Items or the Keys array
Dim v as variant
For Each v in objDictionary.Items
'Do Something
End
Not that being Items an array, v must be declared as a variant type.
It would be much nicer if we could loop using a strongly typed objected instead.
You can do this by wrapping the scripting.Dictionary class in a customized class and letting the Items method return a Collection object.
You can find here an example
Parameter Class
Option Explicit Private mValue As Variant Private mName As String Private mFormat As String Private Sub Class_Initialize() Me.format = "" Me.Name = "" Me.value = Empty End Sub Public Property Get Name() As String Name = mName End Property Public Property Let Name(strName As String) mName = strName End Property Public Property Get value() As Variant If IsObject(mValue) Then Set value = mValue Else value = mValue End If End Property Public Property Let value(varValue As Variant) If IsObject(varValue) Then Set mValue = varValue Else mValue = varValue End If End Property Public Property Get format() As String format = mFormat End Property Public Property Let format(strFormat As String) mFormat = strFormat End Property
Then create a Parameters.cls file and paste the code here.
Parameters Class
Option Explicit Private Const ErrItemIsMissingNum = vbObjectError + 1001 Private Const ErrItemIsMissingSrc = "FFM:Parameters:Item" Private Const ErrItemIsMissingDes = "Item is missing form the collection" Private mKeys As Collection Private mParsDic As Dictionary Private Sub Class_Initialize() Set mParsDic = New Dictionary End Sub Private Sub Class_Terminate() Set mParsDic = Nothing End Sub Public Function Keys() As Collection Dim v As Variant Dim h As Collection Set h = New Collection For Each v In mParsDic.Keys Call h.Add(v) Next Set Keys = h End Function Public Function Items() As Collection Dim v As Variant Dim h As Collection Set h = New Collection For Each v In mParsDic.Items Call h.Add(v) Next Set Items = h End Function Public Function Item(Index As Variant) As Parameter Set Item = mParsDic.Item(Index) End Function Public Sub Add00(Item As Parameter) Call mParsDic.Add(Item.Name, Item) End Sub Public Sub Add01(Name As String, value As Variant, Optional format As String = "") Dim objParameter As Parameter Set objParameter = New Parameter objParameter.Name = Name objParameter.value = value objParameter.format = format Call Me.Add00(objParameter) End Sub Public Function Count() As Long Count = mParsDic.Count End Function Public Function Remove(key As String) mParsDic.Remove (key) End Function Public Function IsInCollection(Name As String) As Boolean IsInCollection = mParsDic.Exists(Name) End Function Public Function Duplicate() As Parameters 'This function Create a New Parameter Collection Dim objDuplicate As Parameters Dim par As Parameter Set objDuplicate = New Parameters For Each par In Me.Items Call objDuplicate.Add01(par.Name, par.value, par.format) Next Set Duplicate = objDuplicate End Function
Once you have done that you will be able to write code like
Dim colPars As Parameters Dim aa As Parameter, bb As Parameter, cc As Parameter Dim h As Variant Set colPars = New Parameters Set aa = New Parameter Set bb = New Parameter Set cc = New Parameter aa.Name = "Mario" bb.Name = "Gennaro" Call colPars.Add00(aa) Call colPars.Add00(bb) For Each cc In colPars.Items Debug.Print cc.Name Next
No comments:
Post a Comment