MartyConnelly
martyconnelly at shaw.ca
Thu Jan 22 12:19:14 CST 2004
These replacement functions work in A97: I got these from a post from
John Viescas http://www.viescas.com/
for VB6 functions Split, Replace, Join and InStrRev
Caveat these may have possible problems on boundary conditions or
optimization and have not undergone full QA.
If you need pure speed replacement functions that have been peer
reviewed, some of the timing differences
are somewhat amazing, most give a 50% improvement, some by a factor of
10 over the internal Access or VB6 intrinsic functions
For timing charts and code.
try http://www.xbeat.net/vbspeed/
Public Function InStrRev(strCheck As Variant, _
strMatch As Variant, _
Optional intStart As Integer = -1, _
Optional intCompare As Integer = 2) As Variant
'-----------------------------------------------------------
' Inputs: String to check,
' match string,
' optional starting position (default = -1),
' optional string compare value (default vbDatabaseCompare)
' Outputs: Position of match string, starting from the end
' Created By: JLV 11/15/01
' Last Revised: JLV 11/15/01
' ** Duplicates the functionality of the VB 6 INSTRREV function.
'-----------------------------------------------------------
Dim intS As Integer, intR As Integer
Dim intI As Integer, intLenC As Integer, intLenM As Integer
' Do some initial checks
If (intCompare < 0) Or (intCompare > 2) Then
Err.Raise 5
Exit Function
End If
If IsNull(strCheck) Then
InStrRev = Null
Exit Function
End If
If VarType(strCheck) <> vbString Then
Err.Raise 5
Exit Function
End If
If IsNull(strMatch) Then
InStrRev = Null
Exit Function
End If
If VarType(strMatch) <> vbString Then
Err.Raise 5
Exit Function
End If
If Len(strCheck) = 0 Then
InStrRev = 0
Exit Function
End If
If Len(strMatch) = 0 Then
InStrRev = intStart
Exit Function
End If
If intStart > Len(strMatch) Then
InStrRev = 0
Exit Function
End If
If Len(strMatch) > Len(strCheck) Then
InStrRev = 0
Exit Function
End If
' OK, have some work to do!
intS = intStart
intLenC = Len(strCheck)
intLenM = Len(strMatch)
If intS = -1 Then intS = intLenC
' Set default not found
InStrRev = 0
' Now loop to see if we can find it
For intI = intS To 1 Step -1
intR = InStr(intI, strCheck, strMatch, intCompare)
If intR <> 0 Then
InStrRev = intR
Exit For
End If
Next intI
End Function
Public Function Join(varArray As Variant, Optional strDelimiter As String =
"") As String
'-----------------------------------------------------------
' Inputs: An array of strings and an optional delimiter
' Outputs: A concatenated string assembled from the
' array elements, delimited by the optional
' delimiter character
' Created By: JLV 09/05/01
' Last Revised: 09/05/01
' ** Duplicates the functionality of the VB 6 JOIN function
'-----------------------------------------------------------
Dim intL As Integer, intU As Integer, intI As Integer
Dim strWork As String
If Not IsArray(varArray) Then Exit Function
intL = LBound(varArray)
intU = UBound(varArray)
strWork = varArray(intL)
For intI = intL + 1 To intU
strWork = strWork & strDelimiter & varArray(intI)
Next intI
Join = strWork
End Function
Public Function Replace(strIn As Variant, strFind As String, _
strReplace As String, Optional intStart As Integer = 1, _
Optional intCount As Integer = -1, _
Optional intCompare As Integer = 0) As String
'-----------------------------------------------------------
' Inputs: String to search and replace,
' search string, replacement string,
' optional starting position (default = 1),
' optional replacement limit (default = -1 .. ALL)
' optional string compare value (default = 0 .. vbBinaryCompare)
' Outputs: Replaced string
' Created By: JLV 09/05/01
' Last Revised: JLV 09/05/01
' ** Duplicates the functionality of the VB 6 REPLACE function.
'-----------------------------------------------------------
Dim strWork As String, intS As Integer, intCnt As Integer
Dim intI As Integer, intLenF As Integer, intLenR As Integer
If (intCompare < 0) Or (intCompare > 2) Then
Err.Raise 5
Exit Function
End If
If VarType(strIn) <> vbString Then
Err.Raise 5
Exit Function
End If
strWork = strIn
intS = intStart
intCnt = intCount
intLenF = Len(strFind)
intLenR = Len(strReplace)
' If find string zero length or count is zero, then nothing to replace
If (intLenF = 0) Or (intCnt = 0) Then
Replace = strIn
Exit Function
End If
' If start beyond length of string, return empty string
If intS > Len(strWork) Then
Replace = ""
Exit Function
End If
' Got some work to do -- find strings to replace
Do
intI = InStr(intS, strWork, strFind, intCompare)
If intI = 0 Then Exit Do
' Insert the replace string
strWork = Left(strWork, intI - 1) & strReplace & Mid(strWork, intI +
intLenF)
intS = intS + intI + intLenR - 1 ' Bump start to end of the replace
string
intCnt = intCnt - 1 ' Decrement the max replace
counter
Loop Until intCnt = 0
Replace = strWork
End Function
Public Function Split(strToSplit As String, _
Optional strDelimiter As String = " ", _
Optional intCount As Integer = -1, _
Optional intCompare 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
' Created By: JLV 09/05/01
' Last Revised: JLV 09/05/01
' ** Duplicates the functionality of the VB 6 SPLIT function.
'-----------------------------------------------------------
Dim strWork As String, intCnt As Integer, intIndex As Integer
Dim intI As Integer, strArray() As String
If (intCompare < 0) Or (intCompare > 2) Then
Err.Raise 5
Exit Function
End If
strWork = strToSplit
intCnt = intCount
' If count is zero, return the empty array
If intCnt = 0 Then
Split = strArray
Exit Function
End If
' If the Delimiter is zero-length, return a 1-entry array
If strDelimiter = "" Then
ReDim strArray(0)
strArray(0) = strWork
Split = strArray
Exit Function
End If
' Decrement count by 1 because function returns
' whatever is left at the end
intCnt = intCnt - 1
' Loop until the counter is zero
Do Until intCnt = 0
intI = InStr(1, strWork, strDelimiter, intCompare)
' If delimiter not found, end the loop
If intI = 0 Then Exit Do
' Add 1 to the number returned
intIndex = intIndex + 1
' Expand the array
ReDim Preserve strArray(0 To intIndex - 1)
' Use index - 1 .. zero-based array
strArray(intIndex - 1) = Left(strWork, intI - 1)
' Remove the found entry
strWork = Mid(strWork, intI + 1)
intCnt = intCnt - 1
Loop
' Put anything left over in the last entry of the array
If Len(strWork) > 0 Then
intIndex = intIndex + 1
ReDim Preserve strArray(0 To intIndex - 1)
strArray(intIndex - 1) = strWork
End If
' Return the result
Split = strArray
End Function
Charlotte Foust wrote:
>There is no built-in replace function in Access 97, so you're stuck with
>clunky code, but the way I've always done this is to search for two
>spaces and replace them with one. If you iterate that until the
>instr([textfield], " ") {that's two spaces, BTW} returns a zero, that
>will get rid of the extra spaces.
>
>Charlotte Foust
>
>-----Original Message-----
>From: Greg Smith [mailto:weeden1949 at hotmail.com]
>Sent: Thursday, January 22, 2004 8:57 AM
>To: Access Developers discussion and problem solving
>Subject: [AccessD] Remove Punctuation
>
>
>Hello everyone! Greetings from Frigid Iowa.
>
>Access 97.
>
>I need to remove punctuation from a single field in a table which has
>about 1,500,000 records in it...so far. It's only 4 columns wide, but
>fairly lengthy.
>
>A client has to have all punctuation removed from this particular field,
>which is a text field. I have code which removes the punctuation (as
>Smith, Greg W. becomes Smith Greg W ) but leaves a space in it's place.
>Yes, it gets rid of the punctuation, but for future consistancy (from
>now on, they are putting the data in without any punctuation) I can't
>have the additional space where the "," or "." was or the search
>routines will not find every instance of, for example, "Smith Greg W"
>because "Smith Greg W " isn't the same.
>
>The code I'm using came from M$'s support, and it does work for removing
>the characters that I want to remove. However, if I use "" instead of "
>", nothing gets changed. It's "ACC: Sample Function to Replace Special
>Characters", article #109825.
>
>Is there a better way to do this? I remember doing this several years
>ago when I was first setting up their data, but it's been waaaaay too
>many moons since then.
>
>Any help would be greatly appreciated!
>
>TIA!
>
>Greg Smith
>Weeden1949 at hotmail.com
>
>
>_______________________________________________
>AccessD mailing list
>AccessD at databaseadvisors.com
>http://databaseadvisors.com/mailman/listinfo/accessd
>Website: http://www.databaseadvisors.com
>_______________________________________________
>AccessD mailing list
>AccessD at databaseadvisors.com
>http://databaseadvisors.com/mailman/listinfo/accessd
>Website: http://www.databaseadvisors.com
>
>
>
--
Marty Connelly
Victoria, B.C.
Canada