VB Script to remove puctuation. 2

[Dustman]

Anybody got a script (or a few minutes to write one) that will remove all punctuation from a string?

Thanks. -Dustin
Rom 8:28

 

[SBendBuckeye]

got something at home. I'll try to post it tonight.

 

[Dalain]

Try this

Function NoSpace(Text As String)
Dim TxtLen, CheckChr, Counter As Long, Message, CurChar, FoundChar As String

Counter = 0
TxtLen = Len(Text)
FoundChar = ""

Do While Counter < TxtLen 'loop.
Counter = Counter + 1 'Count to lenght of text.
CheckChr = Asc(Mid(Text, Counter, 1))
Select Case CheckChr
Case 48 To 57, 65 To 90, 95, 97 To 122
'The Chr is a Letter, Number or Underscore
Case Else
CurChar = Mid(Text, Counter, 1)
If CurChar = &quot; &quot; Then CurChar = &quot;Space&quot;
FoundChar = FoundChar & CurChar & &quot; &quot;
End Select

If Counter = TxtLen Then
If FoundChar <> &quot;&quot; Then
NoSpace = False
Message = MsgBox(&quot;Invalad Characters Found.--> &quot; & FoundChar & Chr(13) & &quot;This Field can only have Letters, Numbers or Underscores&quot; & Chr(13) & &quot;Please remove Characters.&quot;, vbOKOnly, &quot;Input error&quot
Exit Do
Else
NoSpace = True
Exit Do
End If
End If
Loop
End Function


Hope this Helps

Pierre

 

[Dalain]

Sorry, read your post wrong, That Function will detect all invalid punctuations in a string.

Try this one instead

Function RemoveChr(Text As String)
Dim TxtLen, CheckChr, Counter As Long, CurChar, NewText As String

Counter = 0
TxtLen = Len(Text)

Do While Counter < TxtLen 'loop.
Counter = Counter + 1 'Count to lenght of text.
CheckChr = Asc(Mid(Text, Counter, 1))
Select Case CheckChr
Case 48 To 57, 65 To 90, 95, 97 To 122

Case Else

Text = Left(Text, Counter - 1) & Right(Text, TxtLen - Counter)
TxtLen = Len(Text)
Counter = Counter - 1
End Select
Loop
End Function


Pierre

 

[Dustman]

Thanks once again, that was exactly what I needed. I just modified to to return the string, accept spaces, and capitoloze everything. I'm using this in a query for mailing addresses. The mailing department is forcing them to use all caps and no punctuation now. The caps could do just by formating but there wasn't a built in function for the punctuation. Thanks!

[tt]
Public Function StripP(Text As String) As String
'Strips all punctuation from a string.
Dim TxtLen, CheckChr, Counter As Long, CurChar, NewText As String

Counter = 0
TxtLen = Len(Text)

Do While Counter < TxtLen
Counter = Counter + 1
CheckChr = Asc(Mid(Text, Counter, 1))
Select Case CheckChr
Case 32, 48 To 57, 65 To 90, 95, 97 To 122
'Do Nothing
Case Else
Text = Left(Text, Counter - 1) & Right(Text, TxtLen - Counter)
TxtLen = Len(Text)
Counter = Counter - 1
End Select
Loop
StripP = UCASE(Text)
End Function
[/tt] -Dustin
Rom 8:28

 

[Dustman]

One more correction to the above code, I had to add 10 and 13 to the case statement to let carriage returns and line feeds pass through. Case statement now reads:

[tt]Case 10, 13, 32, 48 To 57, 65 To 90, 95, 97 To 122[/tt]

Thanks again! -Dustin
Rom 8:28

 

[SBendBuckeye]

Here are a couple more ways to skin the same cat.

Example 1 - Function has a string defined with chars you want to strip out. It returns a string with them taken out.

Public Function StripPunc(InString As String) As String
Dim strCharsToSkip As String
Dim strResult As String
dim strTemp As String
Dim intX As Integer
strCharsToSkip = &quot;,.;:?&quot; 'Add others as needed
For intX = 1 To Len(InString)
strTemp = Mid$(InString, intX, 1)
If InStr(strCharsToSkip, strTemp) = 0 Then
strResult = strResult & strTemp
End If
Next intX
StripPunc = strResult
End Function 'StripPunc

Invoke Example: strNew = UCase$(Trim$(StripPunc(strVar)))

Example 2 - This example takes advantage of a WinAPI call which tests for AlphaNumeric. It has the advantage of taking care of all the different ranges of ascii values.

Place following in Declarations area of a standard module. I don't know why, but it wouldn't work for me unless I split line 2 and line 3 as shown.

Public Declare Function IsCharAlphaNumeric Lib &quot;User32&quot; Alias &quot;IsCharAlphaNumericA&quot; _
(ByVal cchar As Byte) As Long

Define a public function to test for IsAlphaNumeric. I added the IsNumeric test first because if you passed it .5 it would return true but if you passed it &quot;.5) it would return false.

Public Function MyIsCharAlphaNumeric(pvarIn As Variant) As Boolean
If IsNumeric(pvarIn) Then
MyIsCharAlphaNumeric = True
ElseIf (IsCharAlphaNumeric(Asc(Left$(pvarIn, 1))) = 1) Then
MyIsCharAlphaNumeric = True
Else
MyIsCharAlphaNumeric = False
End If
End Function 'MyIsCharAlphaNumeric

This is a second implementation of StripPunc. Here I used an add string instead but you could use the same logic from the first example if you wanted to. Notice that you can use Access/VBA enumerated constants to make you code easier to read and use (eg vbCrLf instead of CHR(13), etc).

Invoke Example: strNew = UCase$(Trim$(StripPunc2(strVar)))

Good Luck!


Public Function StripPunc2(InString As String) As String
Dim strCharsToAdd As String
Dim strResult As String
Dim strTemp As String
Dim intX As Integer
'Add others as needed
strCharsToAdd = &quot;_-&quot;&quot; '&quot; & vbCrLf & vbCr & vbLf
For intX = 1 To Len(InString)
strTemp = Mid$(InString, intX, 1)
If MyIsCharAlphaNumeric(strTemp) Or _
InStr(strCharsToAdd, strTemp) > 0 Then
strResult = strResult & strTemp
End If
Next intX
StripPunc2 = strResult
End Function

 

[Dalain]

Dustman, my Code was originally used to change a single's field info to into a Dos Type compatible File Name. I like Like you Mods.

SBendBuckeye Code is intresting as well

Pierre