VBA – Building a C# class task with VBA

As I have already mentioned in some articles here and there, in order to find something valuable and interesting to blog about, I convert tasks from C# into VBA. The C# task from the SoftUni looked like this:

Define a class Person that has name, age and email. The name and age are mandatory. The email is optional. Define properties that accept non-empty name and age in the range [1…100]. In case of invalid argument, throw an exception. Define a property for the email that accepts either null or non-empty string containing ‘@’. Define two constructors. The first constructor should take name, age and email. The second constructor should take name and age only and call the first constructor. Implement the ToString() method to enable printing persons at the console.

Ok, writing a C# task in VBA could be somehow difficult, but I managed to do it. However, having two constructors in a class is something impossible for VBA, thus I simply decided to live with one. Furthermore, instead of overriding the  ToString() method (which is N/A) in VBA, I simply created my own function, fShowInformation. At the end, the result was not as tempting, so I made it a little fancier – I have generated three objects from class clsPerson and I have added the to a collection, assigning them random name and age. Three different e-mails were predefined to them:

    Dim colPeople       As New Collection

    Dim cNewPerson1     As New clsPerson
    Dim cNewPerson2     As New clsPerson
    Dim cNewPerson3     As New clsPerson
    
    Dim Person          As clsPerson
    Dim i               As Integer
    
    colPeople.Add cNewPerson1
    colPeople.Add cNewPerson2
    colPeople.Add cNewPerson3
    
    For Each Person In colPeople
        i = i + 1000
        Person.Name = "Peter" & CStr(i) & sSomeRandomName
        Person.Age = Int(90 * Rnd)
        Person.Email = "review" & CStr(i) & "@vitoshacademy.com"
    Next Person

Later I have decided to change one of the Persons with some normal credentials as follows:

    cNewPerson1.Name = "Vitosh"
    cNewPerson1.Age = 29
    cNewPerson1.Email = "N/A"

At the end I print the information for the Person. The trick is that if the person has no e-mail, it is written in the fShowInformation function. Later the classes are terminated.

    For Each Person In colPeople
        Debug.Print Person.fShowInformation(Person.Name, Person.Age, Person.Email)
    Next Person
    
    Set cNewPerson1 = Nothing
    Set cNewPerson2 = Nothing
    Set cNewPerson3 = Nothing

Pretty much, that is it. Here is how the thing works. If you really have the patience to wait for the 90 second demonstration, let me know 🙂

Anyway, last but not least, here comes the code. Two of the functions are copy + edit + paste from the net, I would have done them differently:

Option Explicit
Public Function fValidEmail(sTestMail As String) As Boolean

'function code taken from http://www.vbaexpress.com/kb/getarticle.php?kb_id=281
'Thanks to google I do not have to write something like this.

    Dim strArray As Variant
    Dim strItem As Variant
    Dim i As Long, c As String, blnIsItValid As Boolean
    blnIsItValid = True

    i = Len(sTestMail) - Len(Application.Substitute(sTestMail, "@", ""))
    If i <> 1 Then fValidEmail = False: Exit Function
    ReDim strArray(1 To 2)
    strArray(1) = Left(sTestMail, InStr(1, sTestMail, "@", 1) - 1)
    strArray(2) = Application.Substitute(Right(sTestMail, Len(sTestMail) - Len(strArray(1))), "@", "")
    For Each strItem In strArray
        If Len(strItem) <= 0 Then
            blnIsItValid = False
            fValidEmail = blnIsItValid
            Exit Function
        End If
        For i = 1 To Len(strItem)
            c = LCase(Mid(strItem, i, 1))
            If InStr("abcdefghijklmnopqrstuvwxyz_-.", c) <= 0 And Not IsNumeric(c) Then
                blnIsItValid = False
                fValidEmail = blnIsItValid
                Exit Function
            End If
        Next i
        If Left(strItem, 1) = "." Or Right(strItem, 1) = "." Then
            blnIsItValid = False
            fValidEmail = blnIsItValid
            Exit Function
        End If
    Next strItem
    If InStr(strArray(2), ".") <= 0 Then
        blnIsItValid = False
        fValidEmail = blnIsItValid
        Exit Function
    End If
    i = Len(strArray(2)) - InStrRev(strArray(2), ".")
    If i <> 2 And i <> 3 Then
        blnIsItValid = False
        fValidEmail = blnIsItValid
        Exit Function
    End If
    If InStr(sTestMail, "..") > 0 Then
        blnIsItValid = False
        fValidEmail = blnIsItValid
        Exit Function
    End If
    fValidEmail = blnIsItValid

End Function

Public Sub Main()

    Dim colPeople       As New Collection

    Dim cNewPerson1     As New clsPerson
    Dim cNewPerson2     As New clsPerson
    Dim cNewPerson3     As New clsPerson
    
    Dim Person          As clsPerson
    Dim i               As Integer
    
    colPeople.Add cNewPerson1
    colPeople.Add cNewPerson2
    colPeople.Add cNewPerson3
    
    For Each Person In colPeople
        i = i + 1000
        Person.Name = "Peter" & CStr(i) & sSomeRandomName
        Person.Age = Int(90 * Rnd)
        Person.Email = "review" & CStr(i) & "@vitoshacademy.com"
    Next Person
    
    cNewPerson1.Name = "Vitosh"
    cNewPerson1.Age = 29
    cNewPerson1.Email = "N/A"

    For Each Person In colPeople
        Debug.Print Person.fShowInformation(Person.Name, Person.Age, Person.Email)
    Next Person
    
    Set cNewPerson1 = Nothing
    Set cNewPerson2 = Nothing
    Set cNewPerson3 = Nothing

End Sub


Function sSomeRandomName() As String
'http://stackoverflow.com/questions/22630264/ms-access-visual-basic-generate-random-string-in-text-field
    
    Dim s As String * 8 'fixed length string with 8 characters
    Dim n As Integer
    Dim ch As Integer 'the character
    For n = 1 To Len(s) 'don't hardcode the length twice
        Do
            ch = Rnd() * 127 'This could be more efficient.
            '48 is '0', 57 is '9', 65 is 'A', 90 is 'Z', 97 is 'a', 122 is 'z'.
        Loop While ch < 48 Or ch > 57 And ch < 65 Or ch > 90 And ch < 97 Or ch > 122
        Mid(s, n, 1) = Chr(ch) 'bit more efficient than concatenation
    Next

    sSomeRandomName = s

End Function

The class is named clsPerson

Option Explicit

Public sName    As String
Public iAge     As Integer
Public sEmail   As String

Public Property Get Name() As String

    Name = sName
    Debug.Print "Name taken from memory."
    
End Property

Public Property Let Name(Value As String)
    
    If Len(CStr(Value)) Then
        sName = Value
        Debug.Print "Name is assigned successfully - " & Value
    Else
        Debug.Print "The name cannot be empty!"
        sName = ""
    End If
    
End Property

Public Property Get Age() As Integer

    Age = iAge
    Debug.Print "Age taken from memory."
    
End Property

Public Property Let Age(Value As Integer)

    If (1 < Value) And (Value < 100) Then
        iAge = Value
        Debug.Print "Age is assigned successfully - " & Value
    Else
        Debug.Print "The value should be between 1 and 100!"
    End If
    
End Property

Public Property Get Email() As String

    Email = sEmail
    Debug.Print "Email taken from memory."
    
End Property

Public Property Let Email(Value As String)
    
    If fValidEmail(Value) Then
        sEmail = Value
        Debug.Print "Email is assigned successfully - " & Value
    ElseIf StrComp(Value, "N/A") = 0 Then
        sEmail = ""
    Else
        Debug.Print "Please, enter a valid e-mail!"
    End If
    
End Property

Public Function fShowInformation(fShowName As String, fShowAge As Integer, fShowMail As String) As String
           
    If Len(fShowMail) Then
        fShowInformation = fShowName & " is " & fShowAge & " years old and his e-mail address is " & fShowMail
    Else
        fShowInformation = fShowName & " is " & fShowAge & " years old and no email is available!"
    End If
    
End Function

Private Sub Class_Initialize()
    Debug.Print "ClsPerson is initialized!"
End Sub

Private Sub Class_Terminate()
    Debug.Print "ClsPerson is terminated for " & sName
End Sub

Enjoy it!