Please Note that I have changed address
Go to
Baking Ways / Productive Bytes

Search This Blog


Monday, November 29, 2010

How to get the scripting dictionary enumerator to use in the for each loop in visual basic

A common practice is writing VB 6.0 or VBA code to wrap the Collection object in order to create strongly type Collections.

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

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

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
value = mValue
End If

End Property

Public Property Let value(varValue As Variant)

If IsObject(varValue) Then
Set mValue = varValue
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)
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)
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)
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

No comments:

Post a Comment