-
VB6 SplitToVar
Have you ever wanted to split directly into a few string variables instead of getting a string array?
The sub below does this. Things to know:- The sub will clean up all string variables passed into it.
- String variables are filled in the given order.
- Expression variable is changed: if there are more results than variables, Expression contains what is left.
Code:
Option Explicit
Public Sub SplitToVar(Expression As String, ByVal Delimiter As String, IgnoreDelimiterWithin As String, ParamArray Results())
Dim lngA As Long, lngB As Long, lngCount As Long, lngDelLen As Long, lngExpLen As Long, lngExpPtr As Long, lngIgnLen As Long, lngResults() As Long, Compare As VbCompareMethod, Limit As Long
If LenB(Delimiter) = 0 Then Delimiter = " "
lngExpLen = LenB(Expression)
lngDelLen = LenB(Delimiter)
Compare = vbBinaryCompare
For Limit = 0 To UBound(Results)
Results(Limit) = vbNullString
Next Limit
If lngExpLen > 0 And lngDelLen > 0 And Limit > 0 Then
lngIgnLen = LenB(IgnoreDelimiterWithin)
If lngIgnLen Then
lngA = InStrB(1, Expression, Delimiter, Compare)
Do Until (lngA And 1) Or (lngA = 0)
lngA = InStrB(lngA + 1, Expression, Delimiter, Compare)
Loop
lngB = InStrB(1, Expression, IgnoreDelimiterWithin, Compare)
Do Until (lngB And 1) Or (lngB = 0)
lngB = InStrB(lngB + 1, Expression, IgnoreDelimiterWithin, Compare)
Loop
ReDim lngResults(0 To Limit - 1)
Do While lngA > 0
If lngA + lngDelLen <= lngB Or lngB = 0 Then
lngResults(lngCount) = lngA
lngA = InStrB(lngA + lngDelLen, Expression, Delimiter, Compare)
Do Until (lngA And 1) Or (lngA = 0)
lngA = InStrB(lngA + 1, Expression, Delimiter, Compare)
Loop
lngCount = lngCount + 1
If lngCount = Limit Then Exit Do
Else
lngB = InStrB(lngB + lngIgnLen, Expression, IgnoreDelimiterWithin, Compare)
Do Until (lngB And 1) Or (lngB = 0)
lngB = InStrB(lngB + 1, Expression, IgnoreDelimiterWithin, Compare)
Loop
If lngB Then
lngA = InStrB(lngB + lngIgnLen, Expression, Delimiter, Compare)
Do Until (lngA And 1) Or (lngA = 0)
lngA = InStrB(lngA + 1, Expression, Delimiter, Compare)
Loop
If lngA Then
lngB = InStrB(lngB + lngIgnLen, Expression, IgnoreDelimiterWithin, Compare)
Do Until (lngB And 1) Or (lngB = 0)
lngB = InStrB(lngB + 1, Expression, IgnoreDelimiterWithin, Compare)
Loop
End If
End If
End If
Loop
Else
lngA = InStrB(1, Expression, Delimiter, Compare)
Do Until (lngA And 1) Or (lngA = 0)
lngA = InStrB(lngA + 1, Expression, Delimiter, Compare)
Loop
ReDim lngResults(0 To Limit - 1)
Do While lngA > 0 And lngCount < Limit
lngResults(lngCount) = lngA
lngA = InStrB(lngA + lngDelLen, Expression, Delimiter, Compare)
Do Until (lngA And 1) Or (lngA = 0)
lngA = InStrB(lngA + 1, Expression, Delimiter, Compare)
Loop
lngCount = lngCount + 1
Loop
End If
If lngCount = 0 Then
Results(0) = Expression
Expression = vbNullString
Else
lngExpPtr = StrPtr(Expression)
Results(0) = LeftB$(Expression, lngResults(0) - 1)
For lngCount = 0 To lngCount - 2
Results(lngCount + 1) = MidB$(Expression, lngResults(lngCount) + lngDelLen, lngResults(lngCount + 1) - lngResults(lngCount) - lngDelLen)
Next lngCount
If UBound(Results) > lngCount Then
Results(lngCount + 1) = RightB$(Expression, lngExpLen - lngResults(lngCount) - lngDelLen + 1)
Expression = vbNullString
Else
Expression = RightB$(Expression, lngExpLen - lngResults(lngCount) - lngDelLen + 1)
End If
End If
End If
End Sub
Then a few usage samples:
Code:
' Sample 1
Option Explicit
Private Sub Form_Load()
Dim strA As String, strB As String, strC As String
Dim strExpression As String
strExpression = "A B C D E"
' split by space, no ignore, pass into strA, strB and strC
SplitToVar strExpression, " ", vbNullString, strA, strB, strC
Debug.Print strA, strB, strC
Debug.Print """" & strExpression & """"
End Sub
Code:
' Sample 2
Option Explicit
Private Sub Form_Load()
Dim strA As String, strB As String, strC As String
Dim strExpression As String
strExpression = """A B"" C D E"
' split by space, ignore if within a quote character, pass into strA, strB and strC
SplitToVar strExpression, " ", """", strA, strB, strC
Debug.Print strA, strB, strC
Debug.Print """" & strExpression & """"
End Sub
Code:
' Sample 3
Option Explicit
Private Sub Form_Load()
Dim strA As String, strB As String
Dim strExpression As String
strExpression = """A B"" C D E ""Well that was fun!"" ""Final answer"""
' advanced usage: keep doing until everything is processed (= until given expression is empty)
Do While LenB(strExpression)
SplitToVar strExpression, " ", """", strA, strB
MsgBox strA, , strB
Loop
End Sub