Option Explicit
'local variable to hold collection
Private m_colClients As Collection
Private Sub Add(ByVal Client As clsClient)
'Add the object to the collection
m_colClients.Add Client, Client.clientshort
End Sub
Public Property Get Item(vntIndexKey As Variant) As clsClient
'used when referencing an element in the collection
'vntIndexKey contains either the Index or Key to the collection,
'this is why it is declared as a Variant
'Syntax: Set foo = x.Item(xyz) or Set foo = x.Item(5)
Set Item = m_colClients(vntIndexKey)
End Property
Public Property Get Count() As Long
'used when retrieving the number of elements in the
'collection. Syntax: Debug.Print x.Count
Count = m_colClients.Count
End Property
Public Sub Remove(vntIndexKey As Variant)
'used when removing an element from the collection
'vntIndexKey contains either the Index or Key, which is why
'it is declared as a Variant
'Syntax: x.Remove(xyz)
m_colClients.Remove vntIndexKey
End Sub
Public Property Get NewEnum() As IUnknown
'this property allows you to enumerate
'this collection with the For...Each syntax
Set NewEnum = m_colClients.[_NewEnum]
End Property
Private Sub Class_Initialize()
'creates the collection when this class is created
Set m_colClients = New Collection
End Sub
Private Sub Class_Terminate()
'destroys collection when this class is terminated
Set m_colClients = Nothing
End Sub
'======================================================================
'Procedure :Load (Sub)
'Date :28/09/2004
'InPut :
'Returns :
'Author :© BombDrop
'Purpose :Will load the collection with Client information
'======================================================================
Public Sub Load()
On Error GoTo Load_Error
Dim conClient As ADODB.Connection
Dim cmdClient As ADODB.Command
Dim recClient As ADODB.Recordset
Dim objClient As clsClient
Dim strConnectionString As String
Set conClient = New ADODB.Connection
Set cmdClient = New ADODB.Command
'Set conClient properties and open
conClient.ConnectionString = CONECTIONSTRING
conClient.CursorLocation = adUseClient
conClient.Open
'set and Execute the command
cmdClient.CommandText = "procDemoClient"
Set cmdClient.ActiveConnection = conClient
Set recClient = cmdClient.Execute
DoEvents
Do While Not recClient.EOF
Set objClient = New clsClient
objClient.addressref = recClient!addressref
objClient.analysisarea = recClient!analysisarea
objClient.clientgroupref = recClient!clientgroupref
objClient.clientname = recClient!clientname & ""
objClient.ClientRef = recClient!ClientRef
objClient.clientshort = recClient!clientshort & ""
objClient.Comments = recClient!Comments & ""
objClient.contact1 = recClient!contact1 & ""
objClient.email1a = recClient!email1a & ""
objClient.fax1 = recClient!fax1 & ""
objClient.handler1 = recClient!handler1 & ""
objClient.handler2 = recClient!handler2 & ""
objClient.handler3 = recClient!handler3 & ""
objClient.joindate = recClient!joindate & ""
objClient.leavingdate = recClient!leavingdate & ""
objClient.namesref = recClient!namesref
objClient.salutation = recClient!salutation & ""
objClient.telephone1 = recClient!telephone1 & ""
objClient.usamemo1 = recClient!usamemo1 & ""
objClient.usamemo2 = recClient!usamemo2 & ""
objClient.Address1 = recClient!Address1 & ""
objClient.Address2 = recClient!Address2 & ""
objClient.Address3 = recClient!Address3 & ""
objClient.Address4 = recClient!Address4 & ""
objClient.Address5 = recClient!Address5 & ""
objClient.Address6 = recClient!Address6 & ""
objClient.Postcode = recClient!Postcode & ""
Add objClient
recClient.MoveNext
Loop 'While Not recClient.EOF
'DisconClientect recClientordset
Set recClient.ActiveConnection = Nothing
'Close conClientection
conClient.Close
'Destory objects
Set conClient = Nothing
Set cmdClient = Nothing
Set recClient = Nothing
Set objClient = Nothing
GoTo CleanExit:
Load_Error:
MsgBox "Error " & Err.Number & " (" & Err.Description & ")" & vbCr & _
"Found In Class Module: Clients " & vbCr & "Found In Procedure: Load" & _
vbCr & IIf(Erl > 0, "Found In Line:" & Erl, ""), vbCritical, _
"Error Occurred"
Call LogError("Clients:Load", Err.Description, Err.Number, Erl)
CleanExit:
On Error GoTo 0
End Sub