[AccessD] Remove Punctuation

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





More information about the AccessD mailing list