vbastring-conversion

How do I convert a String to its Enum value similar to Java's .valueOf?

Given an enum:

Public Enum Options
    optionA
    optionB
    optionC
End Enum

and a String myString = "optionB", is there a quick way to convert the String to the corresponding enum-value? (Options.optionB / 1)

I.e. I'm looking for the VBA equivalent of Java's .valueOf()

I'm aware I could write a Select Case, but this is like writing the definition of the enum again and hard to maintain once the enum's values change.

Solution

  • edited 2: added solution #3 which

    solution #3

    1) add a Class module in your project, call it "EnumClass" (or whatever) and put in the following code 

    Option Explicit

Private Enums_ As Variant

Public optionA As String
Public optionB As String
Public optionC As String

Private Sub Class_Initialize()
    optionA = "optionA"
    optionB = "optionB"
    optionC = "optionC"
    Enums_ = GetEnums
End Sub

Public Property Get valueOf(enumText As String) As Long
    Dim i As Long
    valueOf = -1
    For i = LBound(Enums_) To UBound(Enums_)
        If enumText = Enums_(i) Then
            valueOf = i
            Exit For
        End If
    Next i
End Property

Private Function GetEnums() As Variant
    Dim VBProj As VBIDE.VBProject
    Dim CodeMod As VBIDE.CodeModule
    Dim lineCount As Long
    Dim strEnum As String

    Set CodeMod = ActiveWorkbook.VBProject.VBComponents("EnumClass").CodeModule

    lineCount = 9 'if you keep class code as this one, you'd need checking lines from line 9. otherwise set it to 1 as a general setting
    With CodeMod

        Do Until InStr(UCase(.Lines(lineCount, 1)), UCase("Class_Initialize")) > 0
            lineCount = lineCount + 1
        Loop

        lineCount = lineCount + 1
        Do Until InStr(.Lines(lineCount, 1), "Enums_ = GetEnums") > 0
            strEnum = strEnum & GetTextWithingQuotes(.Lines(lineCount, 1)) & ","
            lineCount = lineCount + 1
        Loop
    End With
    GetEnums = Split(Left(strEnum, Len(strEnum) - 1), ",")

End Function

Private Function GetTextWithingQuotes(strng As String) As String
    Dim i1 As Long, i2 As Long

    i1 = InStr(strng, "=")
    i1 = InStr(i1, strng, Chr(34))
    i2 = InStr(i1 + 1, strng, Chr(34))
    GetTextWithingQuotes = Mid(strng, i1 + 1, i2 - i1 - 1)

End Function

    2) do preliminary setting as per here (see from "In order to use the code on this page in your projects, you must change two settings." to "CAUTION" clause included)

    3) exploit it in your main sub as follows

    Option Explicit

Sub main()
Dim Options As New EnumClass '<== declare a variable of the EnumClass (or whatever the name you chose) and set it to a new instance of it
Dim myString As String

myString = "optionB"
MsgBox "string value of 'Options.optionB' = " & Options.optionB 'exploit intellisense
MsgBox "long Value of 'OptionB' =" & Options.valueOf(myString) 'convert the string to corresponding "enum" value

End Sub

    here follows previous solution #2

    1) add a Module in your project, call it "OptionsModule" (or whatever) and place there your "Enum"

    Public Enum Options
    optionA
    optionB
    optionC
End Enum

    2) add a Class module in your project, call it "EnumClass" (or whatever) and put in the following code

    Option Explicit

Private Enums_ As Variant

Public Property Let Enums(enumArr As Variant)
  Enums_ = enumArr
End Property

Public Property Get valueOf(enumText As String) As Long
    Dim i As Long
    valueOf = -1
    For i = LBound(Enums_) To UBound(Enums_)
        If enumText = Enums_(i) Then
            valueOf = i
            Exit For
        End If
    Next i
End Property

    3) add reference to "Microsoft Visual Basic for Applications Extensibility Library"

    4) add this Function (in any module of your project)

    Function GetEnums() As Variant
    Dim VBProj As VBIDE.VBProject '<== this needs that reference to "Microsoft Visual Basic for Applications Extensibility Library"
    Dim CodeMod As VBIDE.CodeModule '<== this needs that reference to "Microsoft Visual Basic for Applications Extensibility Library"
    Dim lineCount As Long
    Dim strEnum As String

    Set CodeMod = ActiveWorkbook.VBProject.VBComponents("OptionsModule").CodeModule

    lineCount = 2
    With CodeMod
        Do Until InStr(UCase(.Lines(lineCount, 1)), UCase("End Enum")) > 0
            strEnum = strEnum & WorksheetFunction.Trim(.Lines(lineCount, 1)) & ","
            lineCount = lineCount + 1
        Loop
    End With
    GetEnums = Split(Left(strEnum, Len(strEnum) - 1), ",")

End Function

    5) exploit it all in your main sub as follows

    Sub main()
Dim OptionsC As New EnumClass '<== declare a variable of the EnumClass (or whatever the name you chose) and set it to a new instance of it
Dim myString As String

OptionsC.Enums = GetEnums() '<== fill your "Enum" class reading Module with enum

myString = "optionB"

MsgBox OptionsC.valueOf(myString) 'convert the string to corresponding "enum" value

End Sub

    here follows previous solution #1

    1) add a Class module, call it "EnumClass" (or whatever) and put in the following code

    Option Explicit

Private Enums_ As Variant

Public Property Let Enums(enumArr As Variant)
  Enums_ = enumArr
End Property

Public Property Get valueOf(enumText As String) As Long
    Dim i As Long
    valueOf = -1
    For i = LBound(Enums_) To UBound(Enums_)
        If enumText = Enums_(i) Then
            valueOf = i
            Exit For
        End If
    Next i
End Property

    2) then in your main sub exploit it as follows

    Option Explicit

Sub main()
Dim Options As New EnumClass '<== declare a variable of the EnumClass (or whatever the name you chose) and set it to a new instance of it
Dim myString As String

Options.Enums = Array("optionA", "optionB", "optionC") '<== fill your "Enum" class with string values

myString = "optionB"

MsgBox Options.valueOf(myString) 'convert the string to corresponding "enum" value

End Sub