Split en Join in MS Access

A.E.Veltstra
2002-05-28, Last modified 2003-01-17.

Zoals je weet heeft Access97 een VBA waar de functies Join, Split en Replace niet in voorkomen. Onderstaand de functies Join en Split. Samen zorgen zij voor een Replace. Op aanraden van dhr. Chad M. Kovac heb ik de Split-functie verbeterd. Voorheen kon de splitter maar 1 karakter bevatten, nu kan hij elke lengte hebben.

(As you know, Access97 uses a VBA that doesn't have the functions Join, Split, nor Replace. Below I provided the functions for Join and Split. Together, they create a Replace. Mr. Chad M. Kovac advised to change the Split function. The splitter used to be limited to one character. Now, it can contain any length.)

Public Function Split(ByVal strSource As String, _
   ByVal strSplitter As String) As Variant
On Error GoTo splitError

Dim varArray() As String
Dim lngPosStart As Long, lngPosStop As Long, lngSourceLength As Long

  lngSourceLength = Len(strSource)
  If (lngSourceLength > 0) Then
    If (Len(strSplitter) > 0) Then
      If (InStr(1, strSource, strSplitter) > 0) Then
        ReDim varArray(0)
        lngPosStart = 1
        'all elements in front of the splitter
        lngPosStop = InStr(lngPosStart, strSource, strSplitter)
        Do While ((lngPosStop > 0) And (lngPosStart <= lngSourceLength))
          varArray(UBound(varArray)) = Mid(strSource, lngPosStart, _
                                       (lngPosStop - lngPosStart))
          ReDim Preserve varArray(UBound(varArray) + 1)
          lngPosStart = (lngPosStop + Len(strSplitter)) 'recent change
          lngPosStop = InStr(lngPosStart, strSource, strSplitter)
        Loop
        'the element after the last splitter
        If (lngSourceLength >= lngPosStart) Then
          varArray(UBound(varArray)) = Mid(strSource, lngPosStart, _
                                       ((lngSourceLength - lngPosStart) + 1))
        Else 'remove empty element at the end
          ReDim Preserve varArray(UBound(varArray) - 1)
        End If
        Split = varArray
      Else
        Split = strSource
      End If
    Else
      Split = strSource
    End If
  Else
    Split = ""
  End If

splitError:
  If (Err.Number <> 0) Then
    Split = strSource
    Err.Clear
  End If

End Function
Public Function Join(ByVal varArray As Variant, _
  ByVal strJoiner As String) As String
  
On Error GoTo joinError

Dim lngMin As Long, lngMax As Long, lngCounter As Long, strBuffer As String
Dim strElement As String, lngElementLength As Long, lngStart As Long

  Join = ""
  strBuffer = String(1000, Chr(0))
  If (IsArray(varArray)) Then
    lngMin = LBound(varArray)
    lngMax = UBound(varArray)
    lngStart = 1
    For lngCounter = lngMin To lngMax
      If (Len(strBuffer) < lngStart) Then 'adjust bufferlength if necessary
        strBuffer = strBuffer & String(1000, Chr(0))
      End If
      strElement = varArray(lngCounter) & strJoiner
      lngElementLength = Len(strElement)
      Mid(strBuffer, lngStart, lngElementLength) = strElement
      lngStart = lngStart + lngElementLength
    Next
    'cut buffer to size: ((lngStart - 1) - strJoiner)
    Join = Left(strBuffer, ((lngStart - 1) - Len(strJoiner)))
  End If

joinError:
  If (Err.Number <> 0) Then
    Join = ""
    Err.Clear
  End If

End Function

Mail OmegaJunior