From Joe "/We Are Borg/" Foster, several years ago. I use this quite
a bit, even in A2K and above. (I seems to work quite well....)
Public Function JoeSplit(ByVal Expression As String, _
Optional ByVal Delimiter As String = " ", _
Optional ByVal Start As Long = 1, _
Optional ByVal Limit As Long = -1, _
Optional ByVal SkipEmptyFields As Boolean = False, _
Optional ByVal vCompare = vbBinaryCompare) _
As Variant
Dim LE As Long: LE = Len(Expression)
Dim LD As Long: LD = Len(Delimiter)
Dim Result() As String
Dim RCount As Long, RMax As Long
' greasy VB6 compatibility stuff
If Limit < -1 Or Start < 1 Then
Err.Raise 5
ElseIf LD > 0 And (LE = 0 Or Limit = 0) Then
JoeSplit = Array()
Exit Function
ElseIf LD = 0 Or Limit = 1 Then
ReDim Result(0 To 0) As String
If Start <> 1 Then Result(0) = Mid$(Expression, Start) _
Else Result(0) = Expression 'StrSwap Result(0), Expression
JoeSplit = Result
Exit Function
End If
If SkipEmptyFields Then RMax = (LE - Start + 1) \ (LD + 1) _
Else RMax = (LE - Start + 1) \ LD
If Limit < 1 Or Limit > 1000 Then _
ReDim Result(0 To RMax) As String _
Else ReDim Result(0 To Limit - 1) As String
Dim Pos1 As Long, Pos2 As Long
Pos1 = Start
Do
If Limit = 1 Then
Pos2 = LE + 1
ElseIf vCompare = vbBinaryCompare Then
Pos2 = InStr(Pos1, Expression, Delimiter, vbBinaryCompare)
Limit = Limit - 1
If Pos2 = 0 Then Pos2 = LE + 1
Else ' slimy performance hack, probably could be improved
' Microsoft has absolutely no excuse whatsoever for making
' this sort of shite necessary or even at all beneficial!
Dim C As Long, p As Long
C = LD * 4
Pos2 = Pos1
Do
p = InStr(1, Mid$(Expression, Pos2, C), Delimiter, vCompare)
If p > 0 Then Pos2 = Pos2 + p - 1: Exit Do
Pos2 = Pos2 + C - 2 * LD ' beware of chr(230) and others!
If C < 600 Then C = C + C \ 2
If Pos2 > LE Then Pos2 = LE + 1: Exit Do
Loop
Limit = Limit - 1
End If
If Pos1 < Pos2 Then
Result(RCount) = Mid$(Expression, Pos1, Pos2 - Pos1)
RCount = RCount + 1
ElseIf SkipEmptyFields = False Then
RCount = RCount + 1
End If
Pos1 = Pos2 + LD
Loop While Pos2 <= LE
If RCount = 0 Then
JoeSplit = Array(): Exit Function
ElseIf RCount <= UBound(Result) Then
ReDim Preserve Result(0 To RCount - 1) As String
End If
JoeSplit = Result
End Function
On 18 Dec 2005 06:47:21 -0800, "Lyle Fairfield"
<ly***********@aim.com> wrote:
Is there a great roll-your-own split function out there. I cobbled one
together yesterday because an e-mail I got asking about same was so
"quaint"!
But it's a few minutes work. Do we have a tested quick one?
--
Drive C: Error. (A)bort (R)etry (S)mack The Darned Thing
