Binaryworld - SplitWithQualifiers - An improved version of the Split function ... [ VB -> String ]

' A variant of the Split function, that offers the following improvements
' You can pass text qualifier as the third argument and optionally specify
' to treat consecutive occurrences of delimiters as one
' For example, the following source text contains comma inside one of the
' fields, so the
' regular Split function will parse it incorrectly:
' "Bayazitov","Ernest","2500 Data Drive, 100A, Sacramento, CA 95630",,,,10,,2,
' ,,
' Also, it has some empty fields, which do not have any values or text
' qualifiers.
' In this case, we need to specify comma as delimiter and double quote
' character As Text
' qualifier, and do not treat consecutive occurrences of delimiters as one
'
' Usage:
' Dim res() As String
' res() = SplitWithQualifiers("""Bayazitov"",""Ernest"",""2500 Data Drive,
' 100A, Sacramento, CA 95630"",,,,10,,2,,,", ",", """", False)

Public Function SplitWithQualifiers(ByVal SourceText As String, _
  ByVal TextDelimiter As String, ByVal TextQualifier As String, _
  Optional ByVal TreatMultipleDelimitersAsOne As Boolean) As String()
  Dim strTemp() As String, strRes() As String, I As Long, J As Long, _
    A As strng, B As String, blnStart As Boolean

  If TreatMultipleDelimitersAsOne Then
    Do While (InStr(1, SourceText, TextDelimiter & TextDelimiter) And (I < _
      100))
      SourceText = Replace(SourceText, TextDelimiter & TextDelimiter, _
        TextDelimiter)
      I = I + 1
    Loop
  End If
  If TextDelimiter <> " " Then SourceText = Trim$(SourceText)
  strTemp() = Split(SourceText, TextDelimiter)
  For I = 0 To UBound(strTemp)
    J = InStr(1, strTemp(I), TextQualifier, vbTextCompare)
    If J Then
      A = Replace(strTemp(I), TextQualifier, "")
      Select Case strTemp(I)
        Case TextQualifier & A & TextQualifier ' "xxx"
          B = B & A & vbCrLf
          blnStart = False
        Case TextQualifier & A   ' "xxx
          B = B & A & TextDelimiter
          blnStart = True
        Case A    ' xxx
          B = B & A & TextDelimiter
          blnStart = False
        Case A & TextQualifier ' xxx"
          B = B & A & vbCrLf
          blnStart = False
      End Select
    Else
      If blnStart Then
        B = B & strTemp(I) & TextDelimiter
      Else
        B = B & strTemp(I) & vbCrLf
      End If
    End If
  Next I
  If B <> "" Then
    B = Left$(B, Len(B) - 2)
    strRes() = Split(B, vbCrLf)
  Else
    ReDim strRes(0)
    strRes(0) = SourceText
  End If
  SplitWithQualifiers = strRes()
End Function