A have a series of objects, a complex data structure, a parent, and a child. The child contains an instance of the parent, has Let and Get Properties, and one method. When the method requests one of the ComplexData objects from the parent, I'm given the old RunTime Error 91 - Object Variable or With Variable not set message. The child is packaging up all the ComplexData objects from iteself and its parent. The error is generated when the Parent Property Get TitleField() is called by the child.
These are the classes (in bold):
ComplexData
Private sName As String
Private vValue As Variant
Public Property Let Name(sInput As String)
sName = sInput
End Property
Public Property Get Name() As String
Name = sName
End Property
Public Property Let Value(vInput)
vValue = vInput
End Property
Public Property Get Value()
Value = vValue
End Property
ParentClass
Private oTitle As ComplexData
Private Sub Class_Initialize()
Set oTitle = New ComplexData
oTitle.Name = "title"
End Sub
Public Property Let Title(vInput)
oTitle.Value = "Lorum"
End Property
Public Property Get Title()
Value = oTitle.Value
End Property
Public Property Set TitleField(oInput As ComplexData)
Set oTitle = oInput
End Property
Public Property Get TitleField() As ComplexData
TitleField = oTitle 'GENERATES ERROR
End Property
ChildClass
Private oParent As ParentClass
Private oContentData As ComplexData
Private Sub Class_Initialize()
Set oParent = New ParentClass
Set oContentData = New ComplexData
oContentData.Name = "content"
End Sub
Public Property Let Content(sInput As String)
oContentData.Value = sInput
End Property
Public Property Get Content() As String
Content = oContentData.Value
End Property
Public Function getFields()
getFields = Array(oContentData, oParent.TitleField)
End Function
I can get around this by setting oTitle to Public in the parent class, and requesting the object directly instead of using the Property.
I'm calling this from a spreadsheet using the following:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Set MyChild = New ChildClass
Fields = MyChild.getFields
field0 = Fields(0).Name
field1 = Fields(1).Name
MsgBox field0 & field1
End Sub
As #Vityata mentioned, adding a “Set” within the Get property fixes the issue.
Related
i'm trying to work with classes in vba and i haven't found any documentation related to managing objects inside objects such as arrays or collections inside a class.
Let's say i have a class person and a class address and i want to manage addresses of a person.
Address
Private pStreet as String
Private pZip as Int
Public Property Let Street(val As String)
pStreet = val
End Property
Public Property Get Street() As String
Street = pStreet
End Property
Public Property Let Zip(val As String)
pZip = val
End Property
Public Property Get Zip() As String
Zip = pZip
End Property
Person
Private pName As String
Private pSurname As String
Private pAddresses As Collection
Public Property Let Name(val As String)
pName = val
End Property
Public Property Get Name() As String
Name = pName
End Property
Public Property Let Surname(val As String)
pSurname = val
End Property
Public Property Get Surname() As String
Surame = pSurname
End Property
Private Sub Class_Initialize()
Set pAddresses = New Collection
End Sub
Private Sub Class_Terminate()
Set pAddresses = Nothing
End Sub
Public Sub addAddress(ByVal val As Address)
pAddresses.Add val
End Sub
Public Property Get Addresses() As Collection
Set Addresses = pAddresses
End Property
Public Property Get Address(ByVal Index As Long) As Address
Set Address = pAddresses(Index)
End Property
Module1
Sub test()
Dim x As Person
Set x = New Person
Dim a1 As Address
Set a1 = New Address
Dim a2 As Address
Set a2 = New Address
x.Name = "Mark"
x.Surname = "Doe"
a1.Street = "first avenue 213"
a1.Zip = "41242"
a2.Street = "second avenue 213"
a2.Zip = "55242"
x.addAddress a1
x.addAddress a2
Debug.Print x.Address(0)
End Sub
how should i deal with the address collection inside the person class?
for instance, how could i retrieve all the addresses or the second address of the collection? x.addresses(1) doesn't work.
The Person class should hold a collection of addresses, to avoid having to expand and preserve an array. The collection should be initialized/terminated as soon as the class is initialized/terminated.
See an example:
Private pAddresses as Collection
Private Sub Class_Initialize()
Set pAddresses = New Collection
End Sub
Private Sub Class_Terminate()
Set pAddresses = Nothing
End Sub
The class can expose the whole address collection via a property for looping, or a single address accessed by index.
Public Property Get Addresses() As Collection
Set Addresses = pAddresses
End property
Public Property Get Address(ByVal Index As Long) As Address
Set Address = pAddresses(Index)
End property
Then you can loop:
Dim p As Person, a As Address
For Each a In p.Addresses
a.Zip = ...
Next
Or get a single address by index:
Set a = p.Addresses(1)
Lastly, a simple Add method, to add an address to the person:
Public Sub AddAddress(ByVal param As Address)
pAddresses.Add param
End Sub
You could also add (or replace) an address using a property by supplying both the address object and the index, but I dont know how useful it is in your case. Of course you need to make sure Index is valid.
Public Property Let Address(ByVal Index As Long, ByVal param As Address)
pAddresses.Add param, Index
End property
Then to call it:
p.Addresses(Index) = a
To enforce the Set keyword, since we're dealing with objects, change Let to Set. Then, you need to set-it:
Set p.Addresses(Index) = a
So I have two Class modules, ClassA and ClassB, and a sub in a module in which I try to add an object from Class B to a property of an object in ClassA.
According to the VBE Glossary, classes are objects and the property set statement can add object types, so it seems like this should be possible. However, when I run the test sub I get an "object variable or with block variable not set" error
The Sub:
Sub test()
Dim Class_A_Object As ClassA
Dim Class_B_Object As ClassB
Set Class_A_Object = New ClassA
Set Class_B_Object = New ClassB
Class_B_Object.Class_B_Property = 42
Class_A_Object.Class_A_Property = Class_B_Object
End Sub
ClassA:
Private a_Class_A_Property As Object
Public Property Set Class_A_Property(pClass_A_Property As Object)
a_ClassA_Property = pClass_A_Property
End Property
Public Property Get Class_A_Property() As Object
Class_A_Property = a_Class_A_Property
End Property
Class B:
Private b_Class_B_Property As Integer
Public Property Let Class_B_Property(pClass_B_Property As Integer)
b_Class_B_Property = pClass_B_Property
End Property
Public Property Get Class_B_Property() As Integer
Class_B_Property = b_Class_B_Property
End Property
Here is the code after I made changes necessary for it to be able to add a class object to my property. As well as making the change pinkfloydx33 suggested, I added the "Set" keyword to the statements of the properties intending to hold the objects and changed data type of said properties to the name of the class to be held.
'The Sub:
Sub test()
Dim Class_A_Object As ClassA
Dim Class_B_Object As ClassB
Set Class_A_Object = New ClassA
Set Class_B_Object = New ClassB
Class_B_Object.Class_B_Property = 42
Set Class_A_Object.Class_A_Property = Class_B_Object
End Sub
'ClassA:
Private a_Class_A_Property As Class B
Public Property Set Class_A_Property(pClass_A_Property As ClassB)
Set a_ClassA_Property = pClass_A_Property
End Property
Public Property Get Class_A_Property() As ClassB
Set Class_A_Property = a_Class_A_Property
End Property
'Class B:
Private b_Class_B_Property As Integer
Public Property Let Class_B_Property(pClass_B_Property As Integer)
b_Class_B_Property = pClass_B_Property
End Property
Public Property Get Class_B_Property() As Integer
Class_B_Property = b_Class_B_Property
End Property
I've been trying to create a class that is a collection of objects (of another class) and that is within a parent class. I've looked at several questions here but couldn't get it working. So if anyone can post a short code with my parameters, I'd be very grateful.
My parent class is Sample. It should contain a collection SampleFields which should contain objects from the class SampleField. The SampleField objects have only a Name property and it is taken from cells A1 to D1. It should be possible to add and remove items from the SampleFields collection and modify the Name property of the SampleField objects. The SampleFields collection gets its objects upon the initialization of the Sample class.
I need to access it like this - Sample.SampleFields(1).Name
I think it's useless to post my attempt but here it is:
Sub test()
Dim a As New Sample, i As Variant
a.GetFields
For Each i In a.SampleFields
Debug.Print i.Name
Next
End Sub
Sample class:
Private pFields As New SampleFields
Public Property Get SampleFields() As SampleFields
Set SampleFields= pFields
End Property
Public Property Set SampleFields(ByVal value As SampleFields)
Set pFields = value
End Property
Private Sub Initialize_Class()
Set pFields = New SampleFields
End Sub
Public Sub GetFields()
Dim rngHeaders As Range, rngCell As Range
Set rngHeaders = Range("A1").CurrentRegion.Rows(1)
For Each rngCell In rngHeaders.Cells
Dim newField As SampleField
newField.Name = rngCell.Value2
Me.Fields.AddNewField (newField) 'crashes here with Method or data member not found
Next
End Sub
SampleFields class:
Private pFields As New Collection
Public Sub AddNewField(FieldName As SampleField)
Me.AddNewField (FieldName)
End Sub
SampleField class:
Private pName As String
Public Property Let Name(value As String)
pName = value
End Property
Public Property Get Name() As String
Name = pName
End Property
Thanks!
Very old post, but let me at least answer this:
In the sample class, have a Collection. You can forget about the SampleFields class, it's not needed.
Then you only need to have one SampleField class that you pass to this SampleClass method "AddField" that you use to increase the size of the collection.
Sample class should look like this:
Private p_SampleFields as Collection
Private p_SampleField as SampleField
'Initialize this class with it's collection:
Private Sub Class_Initialize()
Set p_SampleFields = New Collection
End Sub
'Allow for adding SampleFields:
Public Sub AddField(field as SampleField)
Set p_SampleField = field
p_sampleFields.add field
End Sub
'Expose the collection:
Public Property Get SampleFields() as Collection
Set SampleFields = p_SampleFields
End Property
In a regular module you can then use the following:
Sub Test()
Dim sField as SampleField
Dim sClass as SampleClass
Set sField = New SampleField
Set sClass = New SampleClass
sField.Name = "SomeName"
sClass.AddField sField 'This adds it to the collection
'Access as per requirement:
msgbox sClass.SampleFields(1).Name 'Pop-up saying "SomeName"
End Sub
With a little change in Rik's answer, we can use a public collection, eliminating the need of AddField and Get methods:
Class SampleClass:
Public SampleFields As Collection
Private Sub Class_Initialize()
Set SampleFields = New Collection
End Sub
Then to use it in your module:
Sub Test()
Dim sField as AnyOtherClass
Dim sClass as SampleClass
Set sField = New AnyOtherClass
Set sClass = New SampleClass
sField.Name = "SomeName"
sClass.SampleFields.add sField 'This adds it to the collection
'Access as per requirement:
msgbox sClass.SampleFields(1).Name 'Pop-up saying "SomeName"
End Sub
I've researched as much as I can and never found a definitive answer on this for VBA.
This older StackOverflow post has almost everything, but not quite. VBA Classes - How to have a class hold additional classes
Bottom line - I have a class CClock, which is parent to a Collection of CContacts, which is parent to a CContact.
Is there any way to get at a property of the CClock class from a CContact. So something like Debug.Print , clsContact.Parent.Parent.Lawyer in the code below?
I've tried setting the parents as I thought they should be but get the below error almost immediately at Set clsClock = New CClock. When I follow the code it goes to class terminate event in the Contacts collection, which I can't figure out. (Although that is probably why the error below comes up.)
91 - Object Variable or With Variable not set
The various classes and a quick test rig are below (all based on Dick Kusleika's post in the link.) Thanks.
(Edit- added the test routine, whooopsy)
Sub test()
Dim i As Long, j As Long
Dim clsClocks As CClocks
Dim clsClock As CClock
Dim clsContact As CContact
Set clsClocks = New CClocks
For i = 1 To 3
Set clsClock = New CClock
clsClock.Lawyer = "lawyer " & i
For j = 1 To 3
Set clsContact = New CContact
clsContact.ContactName = "Business Contact " & i & "-" & j
clsClock.Contacts.Add clsContact
Next j
clsClocks.Add clsClock
Next i
For i = 1 To 2
Set clsContact = New CContact
clsContact.ContactName = "Business Contact 66" & "-" & i
clsClocks(2).Contacts.Add clsContact
Next i
'write the data backout again
For Each clsClock In clsClocks
Debug.Print clsClock.Lawyer
For Each clsContact In clsClock.Contacts
Debug.Print , clsContact.ContactName
Debug.Print , clsContact.Parent.Parent.Lawyer
Next clsContact
Next clsClock
End Sub
Clas CClocks
'CClocks
Option Explicit
Private mcolClocks As Collection
Private Sub Class_Initialize()
Set mcolClocks = New Collection
End Sub
Private Sub Class_Terminate()
Set mcolClocks = Nothing
End Sub
Public Property Get NewEnum() As IUnknown
Set NewEnum = mcolClocks.[_NewEnum]
End Property
Public Sub Add(clsClock As CClock)
If clsClock.ClockID = 0 Then
clsClock.ClockID = Me.Count + 1
End If
Set clsClock.Parent = Me
mcolClocks.Add clsClock, CStr(clsClock.ClockID)
End Sub
Public Property Get Clock(vItem As Variant) As CClock
Set Clock = mcolClocks.Item(vItem)
End Property
Public Property Get Count() As Long
Count = mcolClocks.Count
End Property
Public Sub Remove(vItem As Variant)
clsClock.Remove vItem
End Sub
Public Sub Clear()
Set clsClock = New Collection
End Sub
Class CClock
'CClock
Private mlClockID As Long
Private msLawyer As String
Private mlParentPtr As Long
Private mclsContacts As CContacts
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
(dest As Any, Source As Any, ByVal bytes As Long)
Public Property Set Contacts(ByVal clsContacts As CContacts): Set mclsContacts = clsContacts: End Property
Public Property Get Contacts() As CContacts: Set Contacts = mclsContacts: End Property
Public Property Let ClockID(ByVal lClockID As Long): mlClockID = lClockID: End Property
Public Property Get ClockID() As Long: ClockID = mlClockID: End Property
Public Property Let Lawyer(ByVal sLawyer As String): msLawyer = sLawyer: End Property
Public Property Get Lawyer() As String: Lawyer = msLawyer: End Property
Public Property Get Parent() As CClocks: Set Parent = ObjFromPtr(mlParentPtr): End Property
Public Property Set Parent(obj As CClocks): mlParentPtr = ObjPtr(obj): End Property
Private Function ObjFromPtr(ByVal pObj As Long) As Object
Dim obj As Object
CopyMemory obj, pObj, 4
Set ObjFromPtr = obj
' manually destroy the temporary object variable
' (if you omit this step you'll get a GPF!)
CopyMemory obj, 0&, 4
End Function
Private Sub Class_Initialize()
Set mclsContacts = New CContacts
Set Me.Contacts.Parent = Me
End Sub
Private Sub Class_Terminate()
Set mclsContacts = Nothing
End Sub
'CContacts
Option Explicit
Private mcolContacts As Collection
Private mlParentPtr As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
(dest As Any, Source As Any, ByVal bytes As Long)
Public Property Get Parent() As CClock: Set Parent = ObjFromPtr(mlParentPtr): End Property
Private Sub Class_Initialize()
Set mcolContacts = New Collection
End Sub
Private Sub Class_Terminate()
Set mcolContacts = Nothing
End Sub
Public Property Get NewEnum() As IUnknown
Set NewEnum = mcolContacts.[_NewEnum]
End Property
Public Sub Add(clsContact As CContact)
If clsContact.ContactID = 0 Then
clsContact.ContactID = Me.Count + 1
End If
Set clsContact.Parent = Me
mcolContacts.Add clsContact, CStr(clsContact.ContactID)
End Sub
Public Property Get Clock(vItem As Variant) As CContact
Set Clock = mcolContacts.Item(vItem)
End Property
Public Property Get Count() As Long
Count = mcolContacts.Count
End Property
Public Sub Remove(vItem As Variant)
clsContact.Remove vItem
End Sub
Public Sub Clear()
Set clsContact = New Colletion
End Sub
Private Function ObjFromPtr(ByVal pObj As Long) As Object
Dim obj As Object
CopyMemory obj, pObj, 4
Set ObjFromPtr = obj
' manually destroy the temporary object variable
' (if you omit this step you'll get a GPF!)
CopyMemory obj, 0&, 4
End Function
Class CContact
'CContact
Private mlContactID As Long
Private msContactName As String
Private mlParentPtr As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
(dest As Any, Source As Any, ByVal bytes As Long)
Public Property Let ContactID(ByVal lContactID As Long): mlContactID = lContactID: End Property
Public Property Get ContactID() As Long: ContactID = mlContactID: End Property
Public Property Let ContactName(ByVal sContactName As String): msContactName = sContactName: End Property
Public Property Get ContactName() As String: ContactName = msContactName: End Property
Public Property Get Parent() As CContacts: Set Parent = ObjFromPtr(mlParentPtr): End Property
Public Property Set Parent(obj As CContacts): mlParentPtr = ObjPtr(obj): End Property
Private Function ObjFromPtr(ByVal pObj As Long) As Object
Dim obj As Object
CopyMemory obj, pObj, 4
Set ObjFromPtr = obj
' manually destroy the temporary object variable
' (if you omit this step you'll get a GPF!)
CopyMemory obj, 0&, 4
End Function
If you figure out how to access the kernel memory to do this, let me know. Take a look at the source code of vbWatchDog for some hints. I have been studying it to try to gain access to the call stack. I haven't figured it out yet.
I'll show you how to fake it though. I'm going to simplify this a bit. You'll need to apply the principle to your own code. The trick is kind of ugly. It requires that we call an Initialize routine each time we create a new child object
The Parent Class:
'Class Parent
Option Explicit
Private mName as String
Public Property Get Name() as String
Name = mName()
End Property
Public Property Let Name(value As String)
mName = value
End Property
The Child class
'Class Child
Option Explicit
Private mParent as Parent
Public Property Get Parent() as Parent
Set Parent = mParent
End Property
Public Property Let Name(Obj as Parent)
Set mParent = Obj
End Property
Public Sub Initialize(Obj as Parent)
Set Me.Parent = Obj
End Sub
Creating a Child object:
Sub CreateChild()
Dim parentObject As New Parent
' create child object with parent property
Dim childObject As New Child
childObject.Initialize(parentObject)
End Sub
I'm trying to create a class to hold a variable number of items (which are themselves another class object).
So, I have Class 2:
' Class 2 contain each individual quote elements (OTC and MRC)
Private pOTC As String
Private pMRC As String
Public Property Get OTC() As String
OTC = pOTC
End Property
Public Property Let OTC(Value As String)
pOTC = Value
End Property
Public Property Get MRC() As String
MRC = pMRC
End Property
Public Property Let MRC(Value As String)
pMRC = Value
End Property
Then Class 1 contains an array of Class 2:
Private pCurr As String
Private pQuote(20) As Class2
Public Property Get Curr() As String
Curr = pCurr
End Property
Public Property Let Curr(Value As String)
pCurr = Value
End Property
Public Property Set Quote(Index As Integer, cQuote As Class2)
Set pQuote(Index) = cQuote
End Property
Public Property Get Quote(Index As Integer) As Class2
Quote = pQuote(Index)
End Property
And what I would like to do is something like:
Dim myQuotes As Class1
Set myQuotes = New Class1
myQuotes.Curr = "GBP"
myQuotes.Quote(3).OTC = "1200"
The first line setting myQuotes.Curr is no problem, however when I try to set a value inside the array the next line errors with Run-time 91 Object variable or With block variable not set
Any pointers as to what I'm doing wrong and how can I set the values for the elements within the class array?
Thanks in advance!
When you myQuotes.Quote(3) you call Property Get Quote which has an issue.
Your internal array of Class2 is not instantiated so pQuote(Index) refers to an array element of Nothing, when you then myQuotes.Quote(3).OTC = you try to assign to Nothing which fails.
You need to make sure pQuote(Index) is instanced; you can do this on demand:
Public Property Get Quote(Index As Integer) As Class2
If (pQuote(Index) Is Nothing) Then Set pQuote(Index) = New Class2
Set Quote = pQuote(Index)
End Property
(Note the required Set)
Or by adding an intitialisation routine to Class1:
Private Sub Class_Initialize()
Dim Index As Long
For Index = 0 To UBound(pQuote)
Set pQuote(Index) = New Class2
Next
End Sub
You need to set them as New Class2 in Class1:
For intI = LBOUND(pQuote) to UBOUND(pQuote)
Set pQuote(intI) = New Class2
Next IntI
Just as you do with Class1 in your final script.
Maybe it should be
Public Property Let Quote(Index As Integer, cQuote As Class2)
Set pQuote(Index) = cQuote
End Property