Same constant Name in different modules

Question

I have a multi-module VBA project, and each module contains the same constant with different value. (I use this constant to define the version of the module)

Option Explicit
Global Const ModuleVersion As String = "1.1.3"

Then in one module I’d like to check the version of each module:

Sub Test()

    Dim a As String    
    Dim objVBComp As VBComponent

    For Each objVBComp In ThisWorkbook.VBProject.VBComponents
        If objVBComp.Type = vbext_ct_StdModule Then
            a = objVBComp.ModuleVersion
        End If
    Next

End Sub

But whenI check "objVBComp.ModuleVersion" I get the following error:

error 438 "object doesn't support this property or method

What should I do ?

Answer 1

The only thing I can imagine is to parse the code in the module and find the line that has the word Const followed by ModuleVersion eg:

Global Const ModuleVersion As String = "1.1.3"

And then to extract 1.1.3 out of that line.

Option Explicit

Sub Test()
    Dim a As String
    Dim objVBComp As VBComponent

    For Each objVBComp In ThisWorkbook.VBProject.VBComponents
        If objVBComp.Type = vbext_ct_StdModule Then
            Debug.Print objVBComp.Name, GetConstValue(objVBComp.Name, "ModuleVersion")
        End If
    Next
End Sub

Function GetConstValue(ModuleName As String, ConstName As String) As Variant
    Dim Words As Variant
    Dim i As Long, j As Long
    Dim Result As Variant
    Dim LineFound As Boolean

    With ThisWorkbook.VBProject.VBComponents(ModuleName).CodeModule
        For i = 1 To .CountOfDeclarationLines
            Words = Split(.Lines(i, 1), " ")
            For j = 0 To UBound(Words) - 1
                If Words(j) = "'" Or Words(j) = "Rem" Then Exit For
                If Words(j) = "Const" Then
                    If Words(j + 1) = ConstName Then
                        LineFound = True
                    End If
                End If
                If LineFound And Words(j) = "=" Then
                    If Left$(Words(j + 1), 1) = """" Then
                        Result = Mid$(Words(j + 1), 2, Len(Words(j + 1)) - 2)
                    Else
                        Result = Words(j + 1)
                    End If
                    GetConstValue = Result
                    Exit Function
                End If
            Next j
            If LineFound Then Exit Function
        Next i
    End With
End Function

Note that this will not return the value as the correct data type. While this will work for your version string you need to extend it if the correct data type should be read:

Sub Test()
    Dim a As String
    Dim objVBComp As VBComponent

    For Each objVBComp In ThisWorkbook.VBProject.VBComponents
        If objVBComp.Type = vbext_ct_StdModule Then
            Dim ModuleVersion As Variant
            ModuleVersion = GetConstValue(objVBComp.Name, "ModuleVersion")
            Debug.Print objVBComp.Name, ModuleVersion, VarType(ModuleVersion)
        End If
    Next
End Sub

Function GetConstValue(ModuleName As String, ConstName As String) As Variant
    Dim Words As Variant
    Dim i As Long, j As Long
    Dim Result As Variant
    Dim LineFound As Boolean
    Dim DataType As String

    With ThisWorkbook.VBProject.VBComponents(ModuleName).CodeModule
        For i = 1 To .CountOfDeclarationLines
            Words = Split(.Lines(i, 1), " ")
            For j = 0 To UBound(Words) - 1
                If Words(j) = "'" Or Words(j) = "Rem" Then Exit For
                If Words(j) = "Const" Then
                    If Words(j + 1) = ConstName Then
                        LineFound = True
                    End If
                End If
                If LineFound Then
                    If Words(j) = "As" Then
                        DataType = Words(j + 1)
                    Else If Words(j) = "=" Then
                        Select Case LCase$(DataType) ' Byte, Boolean, Integer, Long, Currency, Single, Double, Decimal (currenty not supported), Date, String, Variant
                        Case "byte"
                            Result = CByte(Words(j + 1))
                        Case "boolean"
                            Result = CBool(Words(j + 1))
                        Case "integer"
                            Result = CInt(Words(j + 1))
                        Case "long"
                            Result = CLng(Words(j + 1))
                        Case "currency"
                            Result = CCur(Words(j + 1))
                        Case "single"
                            Result = CSng(Words(j + 1))
                        Case "double"
                            Result = CDbl(Words(j + 1))
                        Case "date"
                            Result = CDate(Words(j + 1))
                        Case "string"
                            Result = CStr(Mid$(Words(j + 1), 2, Len(Words(j + 1)) - 2)) 
                        Case Else 'variant
                            If Left$(Words(j + 1), 1) = """" Then
                                Result = CStr(Mid$(Words(j + 1), 2, Len(Words(j + 1)) - 2))
                            Else
                                Result = CVar(Words(j + 1))
                            End If
                        End Select

                        GetConstValue = Result
                        Exit Function
                    End If
                End If
            Next j
            If LineFound Then Exit Function
        Next i
    End With
End Function

Note that only one declaration per line is parsed.