Split() [Resolved by da_silvy]

[Mark Sreeves]

Now I have your attention...


I need a Split() function on steroids.

I am reading an EDI file into a string and I want split the segments into a String array.

The segement terminator is the apostophe
eg:

DST+980219:1510++++1200'
PDN+A11813+1200:1200+980209:1932'
PDN+A11767+1200:1200+980202:1802'
PDN+A11767+120:120+980202:1801'
PDN+MV291644+1200:1200+980213:0745'
PDN+MV283966+1200:1200+980209:0755'
PDN+MV272008+1200:1200+980129:1339'
DEL+::980219:0700+2400:LIT255::4'
DEL+::980223:2030+1200:LIT267::4'
DEL+::980302:2030+1200:LIT280::4'
TCO+:MCTN++1200'
ADI+3'

Although this example is one segment per line, that is not the case. The EDI file is one long string.

OK, I can hear you thinking "just use Split()" well, it's not that easy because although I want to split on the apostophe, if the apostophe has a ? in front of it, it is NOT a segment terminator.


This is what I'm using at the moment:
(you might recognise it as being based on the "VB6 string funtions in VB5" example from the MSDN site - although I am now using VB6)

Public Function SplitSegments(ByVal sIn As String, SegmentTerminator As String, ReleaseIndicator As String) As Variant
    Dim sRead As String
    Dim sOut() As String
    Dim nC As Long
    
    sRead = ReadUntil(sIn, SegmentTerminator, ReleaseIndicator)
    Do
        ReDim Preserve sOut(nC)
        sOut(nC) = sRead
        
        nC = nC + 1
        sRead = ReadUntil(sIn, SegmentTerminator, ReleaseIndicator)
        DoEvents
    Loop While sRead <> ""
    
    ReDim Preserve sOut(nC)
    sOut(nC) = sIn
    SplitSegments = sOut
End Function
Public Function ReadUntil(ByRef sIn As String, _
      sDelim As String, esc As String, Optional bCompare As VbCompareMethod _
    = vbBinaryCompare) As String
    Dim nPos As Long
    Dim xPos As Long
    
    xPos = InStr(1, sIn, esc & sDelim, bCompare)
    nPos = InStr(1, sIn, sDelim, bCompare)
    
    
    If xPos > 0 Then
      'escaped appostrophe has been found
      If xPos < nPos Then
        nPos = InStr(xPos + 2, sIn, sDelim, bCompare)
      End If
        
    End If
    
    If nPos > 0 Then
        ReadUntil = Left(sIn, nPos - 1)
        sIn = Mid(sIn, nPos + Len(sDelim))
    End If


End Function

It works fine for small files but files can be up to 1.6 MB and it becomes VERY slow


Any ideas how I can speed things up considerably?

Thanks