• Home
 · 
• Databases/Data Access/DAO/ADO
 · 
• VLRecord - Variable Lookup Record Encapsulates a Collection to behave like a HashTable and Record.

VLRecord - Variable Lookup Record Encapsulates a Collection to behave like a HashTable and Record.

VLRecord - Variable Lookup Record Encapsulates a Collection to behave like a HashTable and Record. Great generic method of copying ADO/DAO

API Declarations


'IMPORTANT: Use 'Tools > Procedure Attributes' to define Item as [Default]
'property.





Rate VLRecord - Variable Lookup Record Encapsulates a Collection to behave like a HashTable and Record.

• 1
• 2
• 3
• 4
• 5

(2(2 Vote))

'AUTHOR:  Stephen Goguen
'EMAIL:  [email protected]

'CLASS:  VLRecord

'DESCRIPTION:  Provides the user with a simple Key->Value lookup interface,
'where the user can retrieve and set keys, but cannot enumerate keys or
'values like a hash table.

'EXAMPLE USE:
'Dim George As New Lookup
'Dim Dennis As New Lookup
'
'   George("First Name") = "George"
'   George("Last Name") = "Wilson"
'   George("Age") = 45
'   George("Demeanor") = "Irate"

'   Dennis("First Name") = "Dennis"
'   Dennis("Last Name") = "The Meanace"
'   Dennis("Age") = "Young"

'   Set Dennis("Target") = George

'   Debug.Print Dennis("Target")("First Name")  'Prints George

'   Dennis.Remove "Target"

'   George.RemoveAll

'NOTES:  After reading Advanced Microsoft Visual Basic 5 on the MSDN CD's,
'I rethought using first class data types and using variants instead for
'a number of compelling reasons.

Option Explicit
Dim mKeyLookup As New Collection

'PROPERTY: Get Item
'DESCRIPTION:  Retrieves a Variant VALUE given the KEY.  If value exists
'for the key Null is returned...
Public Property Get Item(ByVal Key As Variant) As Variant
    On Error Resume Next
    Key = CStr(Key)
    If IsObject(mKeyLookup(Key)) = True Then
        Set Item = mKeyLookup(Key)
    Else
        Item = mKeyLookup(Key)
    End If
    If IsEmpty(Item) = True Then
        Item = Null
    End If
End Property

'PROPERTY: Let Item
'DESCRIPTION:  Sets the value of a Key for a simple data type.
Public Property Let Item(ByVal Key As Variant, ByVal Value As Variant)
    On Error Resume Next
    Key = CStr(Key)
    mKeyLookup.Add Value, Key
    If Err.Number <> 0 Then
        mKeyLookup.Remove Key
        mKeyLookup.Add Value, Key
    End If
End Property

'PROPERTY: Set Item
'DESCRIPTION:  Sets the value of a Key for object data types.
Public Property Set Item(ByVal Key As Variant, ByVal Value As Variant)
    On Error Resume Next
    Key = CStr(Key)
    mKeyLookup.Add Value, Key
    If Err.Number <> 0 Then
        mKeyLookup.Remove Key
        mKeyLookup.Add Value, Key
    End If
End Property

'FUNCTION:  Remove
'DESCRIPTION:  Removes a Key->Value pair
Public Function Remove(ByVal Key As Variant)
    On Error Resume Next
    mKeyLookup.Remove Key
End Function

'FUNCTION:  ClearAll
'DESCRIPTION:  Removes all Key->Value pairs
Public Function RemoveAll()
    Set mKeyLookup = New Collection
End Function

!@#$%^&*(/WARNING/!@#$%^&*
'WARNING!!!  -  Cut + Paste functions below into seperate module if needed...

'FUNCTION:  ReadDAORecord
'DESCRIPTION:  Reads from DAO type Recordset to VLRecord
Public Function ReadDAORecord(DAORecordset As DAO.Recordset) As VLRecord
    Dim Field As DAO.Field
    Dim Record As New VLRecord
    
    For Each Field In DAORecordset.Fields
        Record(Field.Name) = Field.Value
    Next
    Set ReadDAORecord = Record
End Function

'FUNCTION:  WriteDAORecord
'DESCRIPTION:  Writes record to DAO type recordset
Public Function WriteDAORecord(DAORecordset As DAO.Recordset, Record As VLRecord)
    Dim Field As DAO.Field

    For Each Field In DAORecordset.Fields
        Field.Value = Record(Field.Name)
    Next
End Function

'FUNCTION:  ReadADORecord
'DESCRIPTION:  Read
Public Function ReadADORecord(ADORecordset As ADODB.Recordset) As VLRecord
    Dim Field As ADODB.Field
    Dim Record As New VLRecord
    
    For Each Field In ADORecordset.Fields
        Record(Field.Name) = Field.Value
    Next
    Set ReadDAORecord = Record
End Function

'FUNCTION:  WriteADORecord
'DESCRIPTION:  Writes record to ADO type recordset
Public Function WriteADORecord(ADORecordset As ADODB.Recordset, Record As VLRecord)
    Dim Field As ADODB.Field

    For Each Field In ADORecordset.Fields
        Field.Value = Record(Field.Name)
    Next
End Function