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