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
ToLowerCase,ToUpperCase, andToProperCase. In OOP terms what you have here is similar to a builder pattern (with the functions returningMe) - I'd consider making it aStringBuilderclass and adding methods toAppend. Browse around in the VBA tag, there's an excellent StringBuilder class waiting to be put to good use =) \$\endgroup\$