Split Function for Access 97
Peter
manipulation. However, it is not avaiable in Access 97.
Is it possible for me to find any VB codes for Split
Function ?
Thanks
Dirk Goldgar
news:094d01c56d59$690f1440$a401...@phx.gbl
Here's one:
'----- start of code -----
Public Function Split( _
Expression As String, _
Optional Delimiter As String = " ", _
Optional ByVal Limit As Long = -1, _
Optional ByVal Compare As Integer = 0) _
As Variant
'-----------------------------------------------------------
' Inputs: String to search,
' delimiter string,
' optional replacement limit (default = -1 .. ALL)
' optional string compare value (default vbBinaryCompare)
' Outputs: Array containing items found in the string
' based on the delimiter provided
' Original code by: John L. Viescas 5-Sep-2001
' Extensively revised by: Dirk Goldgar 21-Jan-2002
' Last Revision: Dirk Goldgar 21-Jan-2002
' ** Duplicates the functionality of the VB 6 SPLIT function.
'-----------------------------------------------------------
Dim lngCnt As Long
Dim intIndex As Integer
Dim lngPos As Long
Dim lngI As Long
Dim strArray() As String
If (Compare < -1) Or (Compare > 2) Then
Err.Raise 5
Exit Function
End If
' If count is zero, return an empty array
If Limit = 0 Then
Split = Array()
Exit Function
End If
' If the Delimiter is zero-length, return a 1-entry array
If Len(Delimiter) = 0 Then
ReDim strArray(0)
strArray(0) = Expression
Split = strArray
Exit Function
End If
' Start count at (Limit - 1) because function returns
' whatever is left at the end.
lngCnt = Limit - 1
' Start scanning at the start of the string.
lngPos = 1
' Loop until the counter is zero.
Do Until lngCnt = 0
lngI = InStr(lngPos, Expression, Delimiter, Compare)
' If the delimiter was not found, end the loop.
If lngI = 0 Then Exit Do
' Add 1 to the number returned.
intIndex = intIndex + 1
' Expand the array to fit in a new element.
ReDim Preserve strArray(0 To intIndex - 1)
' Use index - 1 .. zero-based array
strArray(intIndex - 1) = Mid$(Expression, lngPos, lngI - lngPos)
' Advance past the found entry and the delimiter.
lngPos = lngI + Len(Delimiter)
lngCnt = lngCnt - 1
Loop
' Everything after the last delimiter found goes in the last entry
' of the array.
intIndex = intIndex + 1
ReDim Preserve strArray(0 To intIndex - 1)
If lngPos <= Len(Expression) Then
strArray(intIndex - 1) = Mid$(Expression, lngPos)
Else
strArray(intIndex - 1) = vbNullString
End If
' Return the result
Split = strArray
End Function
'----- end of code -----
--
Dirk Goldgar, MS Access MVP
www.datagnostics.com
(please reply to the newsgroup)
Douglas J. Steele
ByVal Expression As String, _
Optional Delimiter = " ", _
Optional Limit As Long = -1, _
Optional Compare As Integer = vbBinaryCompare _
) As Variant
Dim varValues As Variant
Dim lngCount As Long
Dim intInstr As Integer
Dim intLenDelim As Integer
Const ARRAY_LOW_BOUND = 0
varValues = Array()
If Limit <> 0 Then
lngCount = 0
intLenDelim = Len(Delimiter)
intInstr = InStr(1, Expression, Delimiter, Compare)
Do While intInstr <> 0 And lngCount - Limit + 1 <> 0
ReDim Preserve varValues(ARRAY_LOW_BOUND To lngCount)
varValues(lngCount) = Left(Expression, intInstr - 1)
Expression = Mid(Expression, intInstr + intLenDelim)
intInstr = InStr(1, Expression, Delimiter, Compare)
lngCount = lngCount + 1
Loop
If Len(Expression) <> 0 Then
ReDim Preserve varValues(ARRAY_LOW_BOUND To lngCount)
varValues(lngCount) = Expression
End If
End If
MySplit = varValues
End Function
Hopefully that'll transmit without wordwrap....
--
Doug Steele, Microsoft Access MVP
http://I.Am/DougSteele
(no e-mails, please!)
"Peter" <anon...@discussions.microsoft.com> wrote in message
news:094d01c56d59$690f1440$a401...@phx.gbl...
Albert D.Kallal
box. And, access97 does not have a split function.
You can use:
Public Function strDField(mytext As Variant, delim As String, groupnum As
Integer) As String
' Returnds a group extract from a string via a delimter.
' Hence to grab "cat" from the string dog-cat you get:
' strDField("dog-cat","-",2)
Dim startpos As Integer, endpos As Integer
Dim groupptr As Integer, chptr As Integer
chptr = 1
startpos = 0
For groupptr = 1 To groupnum - 1
chptr = InStr(chptr, mytext, delim)
If chptr = 0 Then
strDField = ""
Exit Function
Else
chptr = chptr + 1
End If
Next groupptr
startpos = chptr
endpos = InStr(startpos + 1, mytext, delim)
If endpos = 0 Then
endpos = Len(mytext) + 1
End If
strDField = Mid$(mytext, startpos, endpos - startpos)
End Function
So, that code example would now become:
Public Function FixId(v As Variant) As Variant
Dim p1 As String
Dim p2 As String
Dim p3 As String
If IsNull(v) Then
Exit Function
End If
p1 = strDField(v, "-", 1)
p2 = strDField(v, "-", 2)
p3 = strDField(p2, "/", 2)
p2 = strDField(p2, "/", 1)
FixId = p1 & p3 & "/" & p2
End Function
It is a little bit different, since I as a developer prefer 1 based index
refs..and vb tends to be zero based.
--
Albert D. Kallal (Access MVP)
Edmonton, Alberta Canada
pleaseNOO...@msn.com
http://www.members.shaw.ca/AlbertKallal