Add Class objects to Collection using a Function in VBA - vba

Question

I have this class:
Option Explicit
Public Code As String
Public ArticleType As String
Public Division As String
Public Devise As String
Public GroupePrix As String
Property Get CodeOnly() As String
CodeOnly = Replace(Code, "*", "")
End Property
And this function:
Function addFabricant(cod As String, art As String, div As String, dev As String, grp As String) As Fabricant
Dim Fab As New Fabricant
Fab.Code = cod
Fab.ArticleType = art
Fab.Division = div
Fab.Devise = dev
Fab.GroupePrix = grp
Set addFabricant = Fab
End Function
And I want to do something like this:
Set Fabricants = New Collection
'This is where the code fail with error 438
Fabricants.Add (addFabricant("Code", "Sample", " ", "DogeCoin", "420"))
...
But it does not work. I'm new to VBA so I may be missing something.
I know that :
Set test = addFabricant("Code", "Sample", " ", "DogeCoin", "420")
Fabricants.Add (test)
is working, but it would add double the code to add all the Fabricant this way.

Answer 1

I think you want "user defined types"
Public Type MyType
MyInt As Integer
MyString As String
MyDoubleArr(2) As Double
End Type
Then use it as a collection or an array.
Dim MyArr(2) As MyType
MyArr(0).MyInt = 31
MyArr(0).MyString = "VBA"
MyArr(0).MyDoubleArr(0) = 1
MyArr(0).MyDoubleArr(1) = 2
MyArr(0).MyDoubleArr(2) = 3
MyArr(1).MyInt = 32
MyArr(1).MyString = "is"
MyArr(1).MyDoubleArr(0) = 11
MyArr(1).MyDoubleArr(1) = 22
MyArr(1).MyDoubleArr(2) = 33
MyArr(2).MyInt = 33
MyArr(2).MyString = "cool"
MyArr(2).MyDoubleArr(0) = 111
MyArr(2).MyDoubleArr(1) = 222
MyArr(2).MyDoubleArr(2) = 333

Answer 2

I would create a wrapper class for your collection and add methods to the FabricantCollection to do what you want. Here is a FabricantCollection started for you:
Option Compare Database
Option Explicit
Private Const MODULE_NAME As String = "FabricantCollection"
Private m_oCollection As Collection
Private Sub Class_Initialize()
Set m_oCollection = New Collection
End Sub
Private Sub Class_Terminate()
If Not m_oCollection Is Nothing Then
Set m_oCollection = Nothing
End If
End Sub
Public Function Add(oFabricant As Fabricant) As Long
m_oCollection.Add oFabricant, oFabricant.Code
Add = m_oCollection.Count
End Function
Public Sub Clear()
Set m_oCollection = New BaseCollection
End Sub
Public Property Get Count() As Long
Count = m_oCollection.Count
End Property
Public Function Item(ByVal vKey As Variant) As Fabricant
Set Item = m_oCollection.Item(vKey)
End Function
Public Function Remove(ByVal vKey As Variant) As Fabricant
Set Remove = m_oCollection.Item(vKey)
m_oCollection.Remove vKey
End Function
Public Function AddNew( _
ByVal sCode As String, _
ByVal sArt As String, _
ByVal sDiv As String, _
ByVal sDev As String, _
ByVal sGrp As String) As Fabricant
Dim oFabricant As Fabricant
If Not oFabricant Is Nothing Then
Err.Raise vbObjectError + 3334, MODULE_NAME & ".AddNew", "Item already exists with that key: " & sCode
Exit Function
End If
Set oFabricant = New Fabricant
With oFabricant
.Code = sCode
.ArticleType = sArt
.Division = sDiv
.Devise = sDev
.GroupePrix = sGrp
End With
Add oFabricant
Set AddNew = oFabricant
End Function
Public Property Get Fabricant( _
ByVal sCode As String) As Variant
Set Fabricant = m_oCollection.Item(sCode)
End Property