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
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