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
Jamal
35.2k13 gold badges134 silver badges238 bronze badges
asked May 30, 2018 at 13:55
\$\endgroup\$
2
  • \$\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\$ Commented May 31, 2018 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\$ Commented May 31, 2018 at 17:12

1 Answer 1

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
answered May 30, 2018 at 23:46
\$\endgroup\$
7
  • \$\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\$ Commented May 30, 2018 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\$ Commented May 31, 2018 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\$ Commented May 31, 2018 at 14:11
  • \$\begingroup\$ @Greedo absolutely! \$\endgroup\$ Commented May 31, 2018 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\$ Commented May 31, 2018 at 14:41

Your Answer

Draft saved
Draft discarded

Sign up or log in

Sign up using Google
Sign up using Email and Password

Post as a guest

Required, but never shown

Post as a guest

Required, but never shown

By clicking "Post Your Answer", you agree to our terms of service and acknowledge you have read our privacy policy.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.