Creating a Parent Class
Hasn’t it been a great class module week? It all started with Rob’s post about custom collection classes, or what I call parent classes. If I make a Person class, I want a People class. If I make an Invoice class, I want an Invoices class to hold all of them.
Back in 2008, I started working on a VBA Framework utility. From that came some code to create a parent class automatically. I could select a class, and it would create a new class module in the same project and put in all the code necessary. It was sweet. After reading Rob’s post, I realized that I never use default properties or For Each constructs with my custom classes, because I’m too darn lazy to export to a text file, type in the appropriate Attribute lines, and reimport. No, instead I’m happy using For Next and calling out each property explicitly.
Then it hit me. If I don’t do something because it’s tedious, why don’t I automate the tedium? I am a programmer, after all. It didn’t take long to realize that I didn’t need to automate the import/export process. Instead, I need to create the parent class as a text file with the Attributes already in there, and just import. And as long as I’m automating tedium, I need to automatically add Rob Bruce’s code to the child class.
I completely refactored my parent class generator code. And here it is:
Dim Child As CodeModule
Dim vbp As VBProject
Dim sCode As String
Dim sclsChild As String, sBaseChild As String
Dim clsParent As CParent
Dim sFile As String, lFile As Long
Set Child = GetChildModule
If Not Child Is Nothing Then
Set vbp = Child.Parent.Collection.Parent
Set clsParent = New CParent
clsParent.ChildClass = Child.Parent.Name
With clsParent
sCode = .Attributes & vbNewLine
sCode = sCode & .ParentCollection & vbNewLine
sCode = sCode & .ClassInits & vbNewLine
sCode = sCode & .GetNewEnum & vbNewLine
sCode = sCode & .SubAdd & vbNewLine
sCode = sCode & .GetItem & vbNewLine
sCode = sCode & .GetCount & vbNewLine
End With
sFile = Environ("USERPROFILE") & "\My Documents\" & clsParent.ParentClass & ".cls"
lFile = FreeFile
Open sFile For Output As lFile
Print #lFile, sCode
Close lFile
vbp.VBComponents.Import sFile
sCode = "Private mlParentPtr As Long" & vbNewLine
sCode = sCode & "Private Declare Sub CopyMemory Lib ""kernel32"" Alias ""RtlMoveMemory"" _" & vbNewLine
sCode = sCode & vbTab & "(dest As Any, Source As Any, ByVal bytes As Long)" & vbNewLine
Child.InsertLines Child.CountOfDeclarationLines + 1, sCode
sCode = clsParent.ParentProperty
Child.InsertLines Child.CountOfLines + 1, sCode
End If
End Sub
Here’s what it does: It creates a text file with a .cls extension and puts in all the code that I want in my parent class. To get all those strings out of my main procedure, I created CParent. Most of the properties of CParent just kick out strings, but it makes it more modular and cleaner looking. There is some string manipulation in there, so it was better than using a bunch of constants. Once the text file is filled, I import it into the project.
Next, I add some code at the end of the declarations section of the child class. This string wasn’t too unwieldy, so I just left in in my main procedure. The next bit of code, the Parent Get and Set properties, was a bit long, so I stuck in the CParent class. Both are inserted into the child via the InsertLines method.
Here are a few examples of properties from CParent
Dim sReturn As String
sReturn = "Private Sub Class_Initialize()" & vbNewLine
sReturn = sReturn & msTAB & "Set " & Me.ParentCollectionName & " = New Collection" & vbNewLine
sReturn = sReturn & "End Sub" & vbNewLine & vbNewLine
sReturn = sReturn & "Private Sub Class_Terminate()" & vbNewLine
sReturn = sReturn & msTAB & "Set " & Me.ParentCollectionName & " = Nothing" & vbNewLine
sReturn = sReturn & "End Sub" & vbNewLine
ClassInits = sReturn
End Property
Public Property Get GetNewEnum() As String
Dim sReturn As String
sReturn = msPUBPROP & " Get NewEnum() As IUnknown" & vbNewLine
sReturn = sReturn & "Attribute NewEnum.VB_UserMemId = -4" & vbNewLine
sReturn = sReturn & "Attribute NewEnum.VB_MemberFlags = ""40""" & vbNewLine
sReturn = sReturn & msTAB & "Set NewEnum = " & Me.ParentCollectionName & ".[_NewEnum]" & vbNewLine
sReturn = sReturn & msENDPROP & vbNewLine
GetNewEnum = sReturn
End Property
Public Property Get SubAdd() As String
Dim sReturn As String
sReturn = "Public Sub Add(" & Me.ChildLocal & " As " & Me.ChildClass & ")" & vbNewLine
sReturn = sReturn & msTAB & "If " & Me.ChildLocal & "." & Me.ChildID & " = 0 Then" & vbNewLine
sReturn = sReturn & msTAB & msTAB & Me.ChildLocal & "." & Me.ChildID & " = Me.Count + 1" & vbNewLine
sReturn = sReturn & msTAB & "End If" & vbNewLine & vbNewLine
sReturn = sReturn & msTAB & "Set " & Me.ChildLocal & ".Parent = Me" & vbNewLine
sReturn = sReturn & msTAB & Me.ParentCollectionName & ".Add " & Me.ChildLocal & ", " & "CStr(" & Me.ChildLocal & "." & Me.ChildID & ")" & vbNewLine
sReturn = sReturn & "End Sub" & vbNewLine
SubAdd = sReturn
End Property
You might notice that I don’t have a Remove method in my parent class. Remove is tricky, I think. It seems to be different for every project and every class. Often, I’ll use a soft delete method, wherein I will set a deleted flag rather than actually removing it from the collection. Then when I store the data (to a text file or an Access database or whatever), I don’t write the records with the deleted flag set. It can get hairy, so I don’t generate that automatically and just hand code it every time.
Finally, I test it all out in another workbook. I create a CPerson class with some made up properties. Then automatically create the CPeople class. Then run this code
Dim clsPeople As CPeople
Dim clsPerson As CPerson
Set clsPeople = New CPeople
Set clsPerson = New CPerson
With clsPerson
.LastName = "Kusleika"
.Age = 41
.BirthDate = #6/26/1969#
.IsMale = True
End With
clsPeople.Add clsPerson
Set clsPerson = New CPerson
With clsPerson
.LastName = "Smith"
.Age = 26
.BirthDate = #1/1/1991#
.IsMale = False
End With
clsPeople.Add clsPerson
'test for_each attribute
For Each clsPerson In clsPeople
Debug.Print clsPerson.LastName, clsPerson.Age
Next clsPerson
'test default item attribute
Debug.Print clsPeople(1).LastName, clsPeople.Person(1).LastName
'test Parent
Debug.Print clsPeople(1).Parent.Count
End Sub
I didn’t show a lot of the code that’s in the file because it would make you all more sleepy. But…
You can download VBHelpers.zip
I used to do this (the whole custom collection class thing). Then I stopped, mostly because I got lazy. You made me feel guilty and I may address that since I can steal your code…
I wrote myself a class collection generator back in 2005. But for reasons unknown within a few months I was back to either copy existing code or typing from scratch.
I’d never seen that code by Rob Bruce you mention. What an elegant solution to the referencing problem.
I notice it’s copying 4 bytes (32 bit). I wonder if this is still stable under Excel 2010, which brings 64 bit to VBA?
RobDick, I look forward to your article on how to safely reference a parent object from a child object without causing a memory leak