4
\$\begingroup\$

This is my first attempt at writing some reusable OOP code. The problem I'm trying to simplify is the confusing (at least to me) structure of VBA string manipulation.

Example

Dim SomeString As String
SomeString = "1234abc"
SomeString = UCase(Left(StrReverse("1234abc"), 3))

I've been using VBA long enough, that I get it. Read the expression inside out, but with .NET this is much more intuitive (again, to me) with method chaining. So with that in mind I made the following class which sort of have a .NET string quality to them. Be sure to save this Class to a file then import it, as I'm setting the default property of this class to be Value with the Attribute Value.VB_UserMemId = 0 Attribute.

Text Class

Option Explicit
Private pText As String

Public Enum SearchDirection
    StartToEnd
    EndToStart
End Enum

Private Sub Class_Initialize()
    pText = vbNullString
End Sub

Private Sub Class_Terminate()
    pText = vbNullString
End Sub

Public Property Get Value() As String
Attribute Value.VB_UserMemId = 0
    Value = pText
End Property

Public Property Let Value(ByVal InputString As String)
    pText = InputString
End Property

Public Function LowerCase() As text
    pText = LCase$(pText)
    Set LowerCase = Me
End Function

Public Function UpperCase() As text
    pText = UCase$(pText)
    Set UpperCase = Me
End Function

Public Function ProperCase() As text
    pText = StrConv(pText, vbProperCase)
    Set ProperCase = Me
End Function

Public Function TrimText() As text
    pText = Trim$(pText)
    Set TrimText = Me
End Function

Public Function LeftTrim() As text
    pText = LTrim$(pText)
    Set LeftTrim = Me
End Function

Public Function RightTrim() As text
    pText = RTrim$(pText)
    Set RightTrim = Me
End Function

Public Function ToByteArray() As Byte()
    ToByteArray = StrConv(pText, vbFromUnicode)
End Function

Public Function ToCharArray() As String()
    Dim tmpArray    As Variant

    tmpArray = VBA.Split(StrConv(pText, vbUnicode), Chr$(0))

    ReDim Preserve tmpArray(LBound(tmpArray) To UBound(tmpArray) - 1)
    ToCharArray = tmpArray
    Erase tmpArray
End Function

Public Function IsInText(ByVal SearchText As String, _
                         Optional ByVal Direction As SearchDirection = SearchDirection.StartToEnd, _
                         Optional ByVal CompareMode As VbCompareMethod = vbTextCompare, _
                         Optional ByVal LookInSearchText As Boolean = False) As Boolean

    If Direction = StartToEnd Then
        If LookInSearchText Then
            IsInText = IIf(InStr(1, SearchText, pText, CompareMode) > 0, True, False)
        Else
            IsInText = IIf(InStr(1, pText, SearchText, CompareMode) > 0, True, False)
        End If
    Else
        If LookInSearchText Then
            IsInText = IIf(InStrRev(1, SearchText, pText, CompareMode) > 0, True, False)
        Else
            IsInText = IIf(InStrRev(1, pText, SearchText, CompareMode) > 0, True, False)
        End If
    End If

End Function

Public Function InTextPosition(ByVal SearchText As String, _
                               Optional ByVal Direction As SearchDirection = SearchDirection.StartToEnd, _
                               Optional ByVal CompareMode As VbCompareMethod = vbTextCompare, _
                               Optional ByVal LookInSearchText As Boolean = False) As Long

    If Direction = StartToEnd Then
        If LookInSearchText Then
            InTextPosition = InStr(1, SearchText, pText, CompareMode)
        Else
            InTextPosition = InStr(1, pText, SearchText, CompareMode)
        End If
    Else
        If LookInSearchText Then
            InTextPosition = InStrRev(1, SearchText, pText, CompareMode)
        Else
            InTextPosition = InStrRev(1, pText, SearchText, CompareMode)
        End If
    End If

End Function

Public Property Get IsTextNull() As Boolean
   IsTextNull = IIf(pText = vbNullString, True, False)
End Property

Public Function Slice(Optional ByVal StartingCharacter As Long = 1, _
                      Optional ByVal EndingCharacter As Long = -1) As text

    If EndingCharacter = StartingCharacter Then EndingCharacter = EndingCharacter + 1

    'Throw an error if the ending character isn't -1, or is less than the starting character
    If EndingCharacter < StartingCharacter And Not EndingCharacter = -1 Then
        Err.Raise vbObjectError + 1, "Text.Slice error", _
                  "You must enter an ending character greater than or equal to the starting character"
        Exit Function
    End If

    If EndingCharacter = -1 Then
        If StartingCharacter >= 1 And Len(pText) > 0 Then pText = Mid$(pText, StartingCharacter, Len(pText))
    Else
        If StartingCharacter >= 1 And Len(pText) > 0 Then pText = Mid$(pText, StartingCharacter, EndingCharacter - StartingCharacter)
    End If

    Set Slice = Me
End Function

Public Function Split(ByVal Delimiter As String, _
                     Optional ByVal Limit As Long = -1, _
                     Optional ByVal CompareMethod As VbCompareMethod = vbTextCompare) As Variant

    Split = VBA.Split(pText, Delimiter, Limit, CompareMethod)
End Function

Public Function Left(ByVal Length As Long) As text
    pText = VBA.Left$(pText, Length)
    Set Left = Me
End Function

Public Function Right(ByVal Length As Long) As text
    pText = VBA.Right$(pText, Length)
    Set Right = Me
End Function

Public Function ReplaceText(ByVal FindText As String, _
                            ByVal ReplaceWith As String, _
                            Optional ByVal Start As Long = 1, _
                            Optional ByVal Count As Long = -1, _
                            Optional ByVal CompareMode As VbCompareMethod = vbTextCompare) As text

    pText = Replace(pText, FindText, ReplaceWith, Start, Count, CompareMode)
    Set ReplaceText = Me
End Function

Public Function ReverseText() As text
    pText = StrReverse(pText)
    Set ReverseText = Me
End Function

Public Property Get Length() As Long
    Length = Len(pText)
End Property

Public Function RegexReplace(ByVal Pattern As String, _
                             Optional ByVal ReplaceWith As String = vbNullString, _
                             Optional ByVal MultiLine As Boolean = True, _
                             Optional ByVal GlobalFlag As Boolean = True, _
                             Optional ByVal IgnoreCase As Boolean = True) As text

    Static RegEx As Object

    If RegEx Is Nothing Then Set RegEx = CreateObject("VBScript.RegExp")

    With RegEx
        .Pattern = Pattern
        .MultiLine = MultiLine
        .Global = GlobalFlag
        .IgnoreCase = IgnoreCase
        pText = .Replace(pText, ReplaceWith)
    End With

    Set RegexReplace = Me
End Function

Public Function RegexMatch(ByVal Pattern As String, _
                           Optional ByVal Delimiter As String = vbNullString, _
                           Optional ByVal GlobalFlag As Boolean = True, _
                           Optional ByVal IgnoreCase As Boolean = True) As text

    Dim i               As Long
    Dim j               As Long
    Dim Matches         As Object
    Dim MatchingValue   As String

    Static RegEx As Object

    If RegEx Is Nothing Then Set RegEx = CreateObject("VBScript.RegExp")

    With RegEx
        .Pattern = Pattern
        .Global = GlobalFlag
        .IgnoreCase = IgnoreCase
        Set Matches = .Execute(pText)
    End With

    For i = 0 To Matches.Count - 1
        If Matches.Item(i).submatches.Count > 0 Then
            For j = 0 To Matches.Item(i).submatches.Count
                MatchingValue = MatchingValue & Delimiter & Matches.Item(i).submatches.Item(j)
            Next
        Else
            MatchingValue = MatchingValue & Delimiter & Matches.Item(i)
        End If
    Next

    If Len(MatchingValue) <> 0 Then MatchingValue = VBA.Right$(MatchingValue, Len(MatchingValue) - Len(Delimiter))

    pText = MatchingValue
    Set RegexMatch = Me
End Function

Client Code Sample

Option Explicit

Public Sub TextExample()
    Dim newString      As text
    Dim i              As Long
    Dim StringArray()  As String
    Dim AnotherArray() As String

    Set newString = New text

    'The value property is the default for the class, just assign it
    newString = " Hello, World! The quick brown fox jumps over the lazy dog   "

    'Let's do sample string manipulations but with method chaining
    If newString.IsInText("fox") Then
        Debug.Print "First Example: " & newString.UpperCase.RegexReplace("\s*").Slice(7, 12)
        newString = "Something Else"
        StringArray = newString.UpperCase.ToCharArray

        For i = LBound(StringArray) To UBound(StringArray)
            Debug.Print "Second Example: " & i, StringArray(i)
        Next

        'Another little example of using a regex pattern to find digits
        'then converting to an array
        newString = "12345 ABC 42 Z 13"
        AnotherArray = newString.RegexMatch("\d+", ",").Split(",")

        For i = LBound(AnotherArray) To UBound(AnotherArray)
            Debug.Print "Third Example: " & i, AnotherArray(i)
        Next
    End If

End Sub

Where I need some help/guidance

I'm definitely not proficient writing or thinking from an OOP perspective yet, so I could use some guidance in the following areas:

  • Is this approach reasonable from an OOP perspective?
  • Naming things is hard, I don't really like "Text" but couldn't think of anything better. Also, not entirely sure my method and property names are great either
\$\endgroup\$
  • \$\begingroup\$ I would have gone with ToLowerCase, ToUpperCase, and ToProperCase. In OOP terms what you have here is similar to a builder pattern (with the functions returning Me) - I'd consider making it a StringBuilder class and adding methods to Append. Browse around in the VBA tag, there's an excellent StringBuilder class waiting to be put to good use =) \$\endgroup\$ – Mathieu Guindon May 31 '18 at 14:49
  • \$\begingroup\$ @MathieuGuindon Yes that StringBuilder class is awesome. I think merging that in here would be worthwhile. Thanks for the feedback :) \$\endgroup\$ – Ryan Wildry May 31 '18 at 17:12
2
\$\begingroup\$

"Is this approach reasonable from an OOP perspective?": I think that this self-referencing style of OOP design should work quite well for what you are trying to accomplish.

"Naming things is hard, I don't really like "Text" but couldn't think of anything better. Also, not entirely sure my method and property names are great either": Text is good name for the class. If you want to change it consider: ExtString, StringPlus, NetString or Strings.

"Any other gotchas or any other feedback would be awesome"

**IsInText** and **InTextPosition**: Both VB.Net and the VBA use Instr to perform the functions of these two methods. There is little merit in having a separate function to return a Boolean (True or False) value. After all the VBA evaluates 0 as False and any other number as True. True itself has a value of -1. The main reason to have the one InStr method is that whoever else that is going to use your class will know its usage, without having to read the code or code docs. Ehh maybe I am nit-picking .Net does have an **IndexOF** method...Nah ditch them and use **Instr**

I know that the class is only sorta like the .Net class, I still expected to see **Clone**, **ToString** and most importantly I think that **Equals**, **ConCat** and **Substring** are absolute must haves. Adding EndsWith and Format will also be very useful. Of course a .Net Format could easily be a class by itself. Text.Format("Wouldn't having a {0} be {1}!", "String Formatter","Awesome").

**Slice**???...oh you mean **Substring** ( I was wonder why that was missing). Use **Substring**. We are after all working with Strings and not Arrays. You should consider changing the parameter names also **StartingCharacter** and **EndingCharacter**. The Character suffix makes me think that you are expecting a character. I don't like the use of **EndingCharacter**. It would be much clearer if you use the **Mid** parameters of **Start** and **Length**. This function is useful but the naming is confusing. Consider changing its signature to Range(Optional StartIndex as long, Optional EndIndex as long) and add a separate **Substring** method.

ToCharArray

Erase tmpArray

Note: The VBA does a pretty good job of garbage collecting. Erasing arrays at the end of a subroutine has no real effect. Similarly, it is rarely necessary to set an Object to Nothing at the end of a subroutine .

It would be interesting to do a speed comparison between the OP's method and this one:

Public Function ToCharArray() As String()
    Dim result() As String
    Dim i As Long
    ReDim result(Len(pText))
    For i = 1 To Len(pText)
        result = Mid$(pText, i, 1)
    Next

    ToCharArray = result
End Function
\$\endgroup\$
  • \$\begingroup\$ thanks very much for the feedback it is appreciated. I'll definitely add in those methods, there are others I want to add as well, so this was more of "hey, am I on the right track". Agreed your ToCharArray method is much cleaner, but splitting by this method always seems to leave an empty string in the last array index, hence the ReDim Preserve tmpArray(LBound(tmpArray) To UBound(tmpArray) - 1) to remove that pesky last array item. I'll erase, erase :) \$\endgroup\$ – Ryan Wildry May 30 '18 at 23:54
  • \$\begingroup\$ As soon as I posted, I went to bed, closed my eyes and it hit me about the redim. So I got up and edited my post. Anyway, nice work. \$\endgroup\$ – user170909 May 31 '18 at 8:00
  • 1
    \$\begingroup\$ Someone should really merge OP's class with this and this in some super addin - then we'd be cooking \$\endgroup\$ – Greedo May 31 '18 at 14:11
  • \$\begingroup\$ @Greedo absolutely! \$\endgroup\$ – Mathieu Guindon May 31 '18 at 14:38
  • \$\begingroup\$ IMO ToString would be redundant, given Value. If the default member attribute can be applied to a method (never tried that, IMO it's more idiomatic to have it on a property), then ToString could have it (and then Value can be removed). \$\endgroup\$ – Mathieu Guindon May 31 '18 at 14:41

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.