Posts
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
