Many times I came across scenario when I wished the magic of .net would have been showered into VBA, by Microsoft. Phew but ne ways…
So recently I thought if I could possibly use the dynamic VBA concept to replicate the property Get/Set in VBA by its name (only) dynamically at run time. And here my attempt on it:
mCodeModule.bas
Function DynamicObjectProperty(oObject As Object, PropertyName As String, Optional PropertyValue As Variant) As Variant Dim VBAEditor As VBIDE.VBE Dim VBProj As VBIDE.VBProject Dim VBComp As VBIDE.VBComponent, getLineNo As Integer, setLineNo As Integer Dim CodeMod As VBIDE.CodeModule, codeString As String, IsInsertedCode As Boolean Set VBAEditor = Application.VBE Set VBProj = Application.ThisWorkbook.VBProject Set VBComp = VBProj.VBComponents("mDynamicModule") Set CodeMod = VBComp.CodeModule IsInsertedCode = False DynamicObjectProperty = False 'Note: These line numbers are very important to determine the line for code to dynamically 'insert/delete getLineNo = 9 setLineNo = 5 If IsMissing(PropertyValue) Then codeString = CodeMod.Lines(getLineNo - 1, 1) 'Get the function/sub header line to identify the operation Else codeString = CodeMod.Lines(setLineNo - 1, 1) 'Get the function/sub header line to identify the operation End If If InStr(1, codeString, "Get", vbTextCompare) > 0 Then CodeMod.InsertLines getLineNo, "DynamicOjectPropertyGetter = obj." & PropertyName DynamicObjectProperty = mDynamicModule.DynamicOjectPropertyGetter(oObject) CodeMod.DeleteLines getLineNo ElseIf InStr(1, codeString, "Set", vbTextCompare) > 0 Then CodeMod.InsertLines setLineNo, "obj." & PropertyName & " = value" mDynamicModule.DynamicOjectPropertySetter oObject, PropertyValue DynamicObjectProperty = True CodeMod.DeleteLines setLineNo End If End Function Sub TestModule1() 'This module is to illustrate the function "DynamicObjectProperty" setter and getter functions 'With this functionsn the class proprty can be dynamically read/set with the name of the property 'as string Dim emp As clsPerson, result As Variant Set emp = New clsPerson 'Intialize the object properties With emp .FirstName = "Alpha" .LastName = "Bravo" .Age = 24 End With 'Dynamically read the object proerty value via its property name Debug.Print DynamicObjectProperty(emp, "LastName") Debug.Print "Object :" & emp.LastName 'Dynamically set the object property DynamicObjectProperty emp, "LastName", "Charlie" 'Dynamically read the object property Debug.Print DynamicObjectProperty(emp, "LastName") Debug.Print "Object :" & emp.LastName End Sub
mDynamicModule.bas
Public Sub DynamicOjectPropertySetter(obj As Object, value As Variant) 'Code Replacer: Set End Sub Public Function DynamicOjectPropertyGetter(obj As Object) As Variant 'Code Replacer: Get End Function
clsPerson.cls
Private m_sFirstName As String Private m_sLastName As String Private m_iAge As Integer Private m_dtJoinDate As Date Public Property Get FirstName() As String FirstName = m_sFirstName End Property Public Property Let FirstName(ByVal sFirstName As String) m_sFirstName = sFirstName End Property Public Property Get LastName() As String LastName = m_sLastName End Property Public Property Let LastName(ByVal sLastName As String) m_sLastName = sLastName End Property Public Property Get Age() As Integer Age = m_iAge End Property Public Property Let Age(ByVal iAge As Integer) m_iAge = iAge End Property Public Property Get JoinDate() As Date JoinDate = m_dtJoinDate End Property Public Property Let JoinDate(ByVal dtJoinDate As Date) m_dtJoinDate = dtJoinDate End Property
Additionally if we are attempting to Get/Set the property values at run time, how can we explore what property names associated with the object at runtime in VBA?? That led me to the following solution below:
mCodeModule.bas
Function GetPropertiesList(oObject As Object) As Variant Dim VBAEditor As VBIDE.VBE Dim VBProj As VBIDE.VBProject, className As String Dim VBComp As VBIDE.VBComponent, lineCount As Integer, result() As Variant Dim CodeMod As VBIDE.CodeModule, codeString As String, rCount As Integer, startCount As Integer className = TypeName(oObject) rCount = 0 ReDim result(1, rCount) Set VBAEditor = Application.VBE Set VBProj = Application.ThisWorkbook.VBProject Set VBComp = VBProj.VBComponents(className) Set CodeMod = VBComp.CodeModule For lineCount = 1 To CodeMod.CountOfLines codeString = CodeMod.Lines(lineCount, 1) startCount = 0 If Len(codeString) > 0 And Left(Trim(codeString), 1) <> "'" Then If InStr(1, codeString, "Public Property Get", vbTextCompare) > 0 Then ReDim Preserve result(1, rCount) result(0, rCount) = "Get" startCount = InStr(1, codeString, "Get", vbTextCompare) + 3 result(1, rCount) = Trim(Mid(codeString, startCount, InStr(1, codeString, "(", vbTextCompare) - startCount)) rCount = rCount + 1 ElseIf InStr(1, codeString, "Public Property Let", vbTextCompare) > 0 Or _ InStr(1, codeString, "Public Property Set", vbTextCompare) > 0 Then ReDim Preserve result(1, rCount) result(0, rCount) = "Set" startCount = InStr(1, codeString, "Set", vbTextCompare) + 3 If startCount = 3 Then startCount = InStr(1, codeString, "Let", vbTextCompare) + 3 End If result(1, rCount) = Trim(Mid(codeString, startCount, InStr(1, codeString, "(", vbTextCompare) - startCount)) rCount = rCount + 1 End If End If Next lineCount GetPropertiesList = result End Function Sub TestModule2() 'This module is for illustrating the function "GetPropertiesList" to extract the properties 'of the class object dynamically into an array Dim emp As clsPerson, result As Variant, iCount As Integer Set emp = New clsPerson 'Get the object property list from its class file result = GetPropertiesList(emp) 'Print the result on to the debug window Debug.Print "Object : emp" For iCount = 0 To UBound(result, 2) Debug.Print result(0, iCount) & ":" & result(1, iCount) Next iCount End Sub
These are the crude way of doing things which I feel, but that’s again one of the ways to achieve the objective. Any improvements and suggestion I would be very keen to know.
The sample workbook is attached for the same:
Very cool.