Dynamic VBA Properties Get/Set

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:

Download

Leave a Reply

Your email address will not be published. Required fields are marked *

*