VB6 SplitToVar

[Merri]

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.

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:

' 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

' 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

' 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