I’m working on a project that requires me to make multiple copies of a custom object. That generally means I make a Duplicate method and assign each property of the source instance to the copy instance. It’s not terrible, but I just have to be careful that when I change the properties of the class that I update the Duplicate method. I decided that I would see what other options are available and I found this StackOverflow answer that I think is interesting. So I tried it.
Instead of declaring a bunch of private variables in the class and all the getters and setters for those variables, all of the property values will be in a user-defined type. The UDT variable will be private to the class, but the actual UDT has to be in a standard module because VBA won’t let you put types in a class module. Now when I want to clone that class instance, I can pass the whole UDT variable. Unlike a class that passes the reference, the UDT makes a copy of all of the values in memory so you end up with two separate structures in memory – just what I want for a clone.
I made a CContact class that will have a FirstName, LastName, and LastContact property. The poorly named LastContact property is the date last contacted. I wanted to put at least two different data types (String and Date) in the class for demonstration purposes. The declaration of CContact looks like this:
|
1 2 |
Private mlContactID As Long Private mtContactMemento As ContactMemento |
I only have two private variables; ContactID that never want to copy and a ContactMomento variable that contains all the data that I do want to copy. I keep the ContactID getter and setter the same as I normally would, but the mtContactMomento property statements are a little different. First, let’s look at the ContactMomento type. This is in my MGlobals standard module.
|
1 2 3 4 5 |
Public Type ContactMemento FirstName As String LastName As String LastContact As Date End Type |
I named the type ObjectName + Memento. Memento is from the Memento pattern, which is typically used to store a previous state for Undo purposes, although we’re not really using it like that here. The UDT holds all of the properties that I want to copy to a new class instance. Back in the class, the typical getters and setters look like this:
|
1 2 3 4 5 6 7 8 9 10 11 |
Public Property Let FirstName(ByVal sFirstName As String) mtContactMemento.FirstName = sFirstName End Property Public Property Get FirstName() As String FirstName = mtContactMemento.FirstName End Property |
That’s pretty much the same as typical property statements except I’m pulling the data from my private ContactMemento variable instead of individual variables for each project. With that all set up, this works just like a class that I would create normally – not using a UDT. The last bit of setup that I need is property statements for the ContactMemento as a whole.
|
1 2 3 4 5 6 7 8 9 10 11 |
Public Property Let ContactMemento(tContactMemento As ContactMemento) mtContactMemento = tContactMemento End Property Public Property Get ContactMemento() As ContactMemento ContactMemento = mtContactMemento End Property |
And then I need a way to clone the class, so I create a Clone property.
|
1 2 3 4 5 6 7 8 9 10 |
Public Property Get Clone() As CContact Dim clsReturn As CContact Set clsReturn = New CContact clsReturn.ContactMemento = Me.ContactMemento Set Clone = clsReturn End Property |
By assigning the ContactMemento from the source instance to the class instance, all the properties I want to copy are done so in one shot rather than one at a time. If I add any properties to the class, I don’t have to adjust the Clone property, which means that I won’t forget and miss a property. Let’s test it out. If create one instance, then clone it and change the LastContact property just for some variety.
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 |
Sub FillClass() Dim clsContact As CContact Set gclsContacts = New CContacts Set clsContact = New CContact With clsContact .FirstName = "Dick" .LastName = "Kusleika" .LastContact = Date End With gclsContacts.Add clsContact End Sub Sub CloneClass() Dim clsClone As CContact Dim clsSource As CContact Dim clsContact As CContact FillClass Set clsSource = gclsContacts.Contact(1) Set clsClone = clsSource.Clone clsClone.LastContact = Date + 1 gclsContacts.Add clsClone For Each clsContact In gclsContacts With clsContact Debug.Print .ContactID, .FirstName, .LastName, .LastContact End With Next clsContact End Sub |
That outputs:
I like a system that doesn’t rely on me being careful to update a Clone or Duplicate method. But there are some things I don’t like too. With this method, my class is not longer self-contained. The UDT declaration has to live in a standard module. If I copy my class module to another project, it won’t compile until I declare the UDT in the new project. I would also have to change all of my code generation stuff to use a UDT rather than individual private variables. In all the code I’ve written, I’ve probably only had to clone class instances about a half dozen times, so it’s probably not worth it.
You can download CloneClass.zip
Dick, To keep it all in the class, could you use a collection in place of the UDT? That would also handle your mixed data types. The collection items and keys would be analogous to the UDT values and member names. I think.
Anyways, great post. I didn’t know about the Memento pattern before.
I like Dick’s approach despite the dependency on the externally declared UDT.
Using a Collection would result in unwieldy referencing.
Contact memento could be a dictionary, or even better a custom class that is a dictionary,
This contactmemento class will have a duplicate method, that will run through the dictionary and create a copy of its elements. This way you have iecapsulated away from the contact object the varying parameters, you will have a specialised class for them, which will take care of duplication, validation and so on.
Also you don’t need to expand the user defined type, just add a new key to the class and evening else works
Unfortunately this approach only seems to work for simple types. I tried cloning a memento containing a Collection object, but it did not copy the values stored in the collection.
To get the same results I’d prefer
<lang=”vb”>Sub M_snb()
Set c_00 = CreateObject(“scripting.dictionary”)
c_00.Add “firstname”, “dddd”
c_00.Add “lastname”, “eee”
c_00.Add “date”, Date
MsgBox c_00(“firstname”) & vbLf & c_00(“lastname”) & vbLf & c_00(“date”)
Set c_01 = c_00
c_01(“date”) = c_01(“date”) + 1
MsgBox c_01(“firstname”) & vbLf & c_01(“lastname”) & vbLf & c_01(“date”)
End Sub
That will even ‘clone’ a dictionary or collection in the dictionary.
Sub M_snb()
Set c_00 = CreateObject(“scripting.dictionary”)
@snb I must be missing something. Your code creates two references (c_00 and c_01) to the same object in memory. Any changes to c_01 will change c_00. The whole point is to create independent objects.
You don’t, I did.