Seeking suitable A97 FN for removing punctuation from a string

[MLH]

Back in mid-2003, lucason posted a question about removing
punctuation chars from a string. Suggested code was posted
using Replace function. Could the FN below be easily modified
for use with A97 which has no replace FN?

xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx xxxxxxxxxx
lucason
View profile
More options Aug 20 2003, 5:52 am
Newsgroups: comp.databases.ms-access
From: [e-mail] (lucason)
Date: 20 Aug 2003 02:52:36 -0700
Local: Wed, Aug 20 2003 5:52 am
Subject: Re: Remove Specific Characters From A text box
Reply to author | Forward | Print | Individual message | Show original
| Report this message | Find messages by this author

[e-mail] (Colin Graham) wrote in message
<news:ee**************************@posting.google. com>...

I need to write a function to remove any sort of punctuation from a
text box and only allow the characters from A to Z. E.g. If i type in
"Róisín" then i want the system not to allow this, even better if it
could change it to "Roisin" or if possible to remove any character
which isnt between A to Z. i am a bit stuck with this. Can anyone
please help????

You didn't look very far before asking the question did you....

Use the replace command!

Put it in a function if you like:

'StartCode-----------------------
Public Function FixString(strStringToChange As String) As String
Dim x As Integer

For x = 1 To Asc("A")
strStringToChange = Replace(strStringToChange, Chr(x), "")
Next x
For x = Asc("z") To 255
strStringToChange = Replace(strStringToChange, Chr(x), "")
Next x
FixString = strStringToChange
End Function
'-------------------------EndCode

If you like, you can add specific replacements:

'StartCode2-----------------------
Public Function FixString(strStringToChange As String) As String

strStringToChange = replace(strStringToChange,"ó","o")
strStringToChange = replace(strStringToChange,"í","i")
'Add as many as you like

'Then delete all remaing
Dim x As Integer

For x = 1 To Asc("A")
strStringToChange = Replace(strStringToChange, Chr(x), "")
Next x
For x = Asc("z") To 255
strStringToChange = Replace(strStringToChange, Chr(x), "")
Next x
FixString = strStringToChange
End Function
'-------------EndCode2

Plug that in and then try

? FixString ("Róis1ín")

in the debug window

[MLH]

The obvious course of action would be to roll your own Replace
function like the one below. But calling the homegrown procedure
over and over again seems intense. I'm wondering if there's something
simpler...
Function ReplaceThisCharWThatChar(OriginalString As String, ThisChar
As String, ThatChar As String) As String

On Error GoTo Err_ReplaceThisCharWThatChar
Dim NewString As String, CurrentCharacter As String
Dim StringLen As Integer, CurrentCharacterPosition As Integer
OriginalString = Trim(OriginalString)
StringLen = Len(OriginalString)

If StringLen = 0 Then ReplaceThisCharWThatChar = "": Exit Function
If Len(ThisChar) <1 Or Len(ThatChar) <1 Then
ReplaceThisCharWThatChar = "": Exit Function

For CurrentCharacterPosition = 1 To StringLen
CurrentCharacter = Mid$(OriginalString, CurrentCharacterPosition,
1) 'Get the CurrentCharacter
If CurrentCharacter = ThisChar Then CurrentCharacter = ThatChar
'If the current character is a ThisChar, change it to a ThatChar.
NewString = NewString & CurrentCharacter
'Append the current char to the new string
Next CurrentCharacterPosition
ReplaceThisCharWThatChar = NewString

Exit_ReplaceThisCharWThatChar:
Exit Function

Err_ReplaceThisCharWThatChar:
Dim r As String, k As String, Message3 As String
r = "The following unexpected error occurred in StringFunctions'
global FN ReplaceThisCharWThatChar."
k = CRLF & CRLF & str$(Err) & ": " & Quote & Error$ & Quote
Message3 = r & k
MsgBox Message3, 48, "Unexpected Error - " & MyApp$ & ", rev. " &
MY_VERSION$
Resume Exit_ReplaceThisCharWThatChar

End Function

[Arch]

On Sun, 02 Sep 2007 11:33:13 -0400, MLH <CR**@NorthState.netwrote:

>The obvious course of action would be to roll your own Replace
function like the one below. But calling the homegrown procedure
over and over again seems intense. I'm wondering if there's something
simpler...
Function ReplaceThisCharWThatChar(OriginalString As String, ThisChar
As String, ThatChar As String) As String

On Error GoTo Err_ReplaceThisCharWThatChar
Dim NewString As String, CurrentCharacter As String
Dim StringLen As Integer, CurrentCharacterPosition As Integer
OriginalString = Trim(OriginalString)
StringLen = Len(OriginalString)

If StringLen = 0 Then ReplaceThisCharWThatChar = "": Exit Function
If Len(ThisChar) <1 Or Len(ThatChar) <1 Then
ReplaceThisCharWThatChar = "": Exit Function

For CurrentCharacterPosition = 1 To StringLen
CurrentCharacter = Mid$(OriginalString, CurrentCharacterPosition,
1) 'Get the CurrentCharacter
If CurrentCharacter = ThisChar Then CurrentCharacter = ThatChar
'If the current character is a ThisChar, change it to a ThatChar.
NewString = NewString & CurrentCharacter
'Append the current char to the new string
Next CurrentCharacterPosition
ReplaceThisCharWThatChar = NewString

Exit_ReplaceThisCharWThatChar:
Exit Function

Err_ReplaceThisCharWThatChar:
Dim r As String, k As String, Message3 As String
r = "The following unexpected error occurred in StringFunctions'
global FN ReplaceThisCharWThatChar."
k = CRLF & CRLF & str$(Err) & ": " & Quote & Error$ & Quote
Message3 = r & k
MsgBox Message3, 48, "Unexpected Error - " & MyApp$ & ", rev. " &
MY_VERSION$
Resume Exit_ReplaceThisCharWThatChar

End Function

You are correct. That previously offered solution was quite
inefficient. Scan the string that gets passed to the function, one
character at a time. If the ASC of the character is in range, for
example:

a = ASC(C)
if (a 64 and a < 91) or (a 96 and a < 123) then
keep the character
else
discard it

would be much more efficient that blasting through replace of every
unwanted character.

[lyle]

On Sep 2, 11:33 am, MLH <[e-mail]:

The obvious course of action would be to roll your own Replace
function like the one below. But calling the homegrown procedure
over and over again seems intense. I'm wondering if there's something
simpler...

Function ReplaceThisCharWThatChar(OriginalString As String, ThisChar
As String, ThatChar As String) As String

On Error GoTo Err_ReplaceThisCharWThatChar
Dim NewString As String, CurrentCharacter As String
Dim StringLen As Integer, CurrentCharacterPosition As Integer
OriginalString = Trim(OriginalString)
StringLen = Len(OriginalString)

If StringLen = 0 Then ReplaceThisCharWThatChar = "": Exit Function
If Len(ThisChar) <1 Or Len(ThatChar) <1 Then
ReplaceThisCharWThatChar = "": Exit Function

For CurrentCharacterPosition = 1 To StringLen
CurrentCharacter = Mid$(OriginalString, CurrentCharacterPosition,
1) 'Get the CurrentCharacter
If CurrentCharacter = ThisChar Then CurrentCharacter = ThatChar
'If the current character is a ThisChar, change it to a ThatChar.
NewString = NewString & CurrentCharacter
'Append the current char to the new string
Next CurrentCharacterPosition
ReplaceThisCharWThatChar = NewString

Exit_ReplaceThisCharWThatChar:
Exit Function

Err_ReplaceThisCharWThatChar:
Dim r As String, k As String, Message3 As String
r = "The following unexpected error occurred in StringFunctions'
global FN ReplaceThisCharWThatChar."
k = CRLF & CRLF & str$(Err) & ": " & Quote & Error$ & Quote
Message3 = r & k
MsgBox Message3, 48, "Unexpected Error - " & MyApp$ & ", rev. " &
MY_VERSION$
Resume Exit_ReplaceThisCharWThatChar

End Function

I don't know if this will run in Access97 or not. It will ldepend on
the version of Windows being used. If it will, it should be very fast.
If it won't, it will be even faster.

Public Sub RemoveCharacters( _
ByRef InputString$, _
ByVal Characters$)
' requires that Visual Basic Script be installed
' VBS is installed by default with Windows
' it disappears only with direct action by an administrator
Dim re As Object
Set re = CreateObject("VBScript.RegExp")
InputString = Trim(InputString)
With re
.Global = True
.IgnoreCase = True
.Pattern = "[" & Characters & "]"
InputString = .Replace(InputString, "")
End With
Set re = Nothing
End Sub

Public Sub test()
Dim test$
test = "Whatever you say, Big Fellow!"
RemoveCharacters test, "\!\,\;\:"
Debug.Print test
'Whatever you say Big Fellow
End Sub

The test removes the exclamation point, (\!), the comma (\,), the semi-
colon (\;) and the colon (\:).

You could copy the code to a 97 module, run the test sub and tell us
if it works.