Access VBA automation for replacing text

[coopsman]

Does anyone know of a VBA procedure that will replace periods in a table with a blank. I can't get an update query to work (tried updating "*.*" to "" but it wiped the field out completely) because the periods are within names and not at the same positions. For example, I want to be able to change I.B.M. to IBM, and Bank L.P. to Bank LP. Any help would be appreciated. Jim.

 

[Zorro1265]

Well I know this isnt a code solution but the replace function in the edit menu will work in a table. I used to get rid of a bullet in front of about 10,000 records that way. Zorro

 

[coopsman]

Thanks for your comment, zorro. However, I'd like this to be VBA code because it will be a part of a periodic import procedure. Any other ideas??

 

[overClok6]

Here's something that might help. You can use this function that will actually replace the characters within a specified string with some other characters. This is MUCH better than using the MID statement because it doesn't care about the length of the string you are replacing or replacing. You can also use it to remove a group of characters from a string.

Function ReplaceString(ByVal SourceString As String, ByVal OriginalString As String, ByVal NewString As String) As String
'Recursive function ReplaceString searches Source string and replaces ALL OCCURRENCES of OriginalString with NewString.
'If a value for NewString is ommitted (or IsEmpty), then all occurrences of OriginalString are removed from the SourceString!

Dim Position As Integer

If SourceString = "" Or IsNull(SourceString) Then
ReplaceString = SourceString
Else
Position = InStr(1, SourceString, OriginalString)
If Position > 0 Then
ReplaceString = (Mid$(SourceString, 1, Position - 1) & NewString & ReplaceString(Mid(SourceString, Position + Len(OriginalString)), OriginalString, NewString))
Else
ReplaceString = SourceString
End If
End If

End Function


You may use this function in your native SQL statements or in your VB code. Just copy this function code to your module.

 

[raskew]

You might test this using a copy of Northwind's Product table (Product1).

Function ReplaceOmatic(pTable As String, pString As String, pRepwith As String)
'*******************************************
'Name: ReplaceOmatic (Function)
'Purpose: Search and replace for all text
' and memo fields in specified table
'Inputs: ptable: Table to search
' pString: String to replace
' pRepWith: Replacement string
'To call: from debug window: ? replaceomatic("Products1","o","~~&quot
'To recover: ? replaceomatic("Products1","~~","o&quot
'*******************************************

Dim db As DATABASE
Dim rs As Recordset
Dim strSQL As String
Dim td As TableDef
Dim namehold As String 'field name
Dim typehold As Integer 'field type
Dim lenhold As Integer 'field size
Dim namefix As String 'contents of namehold
Dim i As Integer, n As Integer
Dim j As Integer, k As Integer, l As Integer
Dim lefthold As String, righthold As String

Set db = CurrentDb
Set td = db.TableDefs(pTable)

'loop through the table's fields, select text or memo fields
i = td.Fields.Count

For n = 0 To i - 1
If td.Fields.Type = dbText Or td.Fields.Type = dbMemo Then
'dbText = 10; dbMemo = 12
'tried to used an In()statement here, but couldn't get it to work
namehold = td.Fields.name
lenhold = td.Fields.Size
typehold = td.Fields.Type
Debug.Print namehold & "; " & lenhold & ";" & typehold

strSQL = "SELECT " & namehold & " FROM " & pTable & " WHERE " _
& "Instr([" & namehold & "], """ & pString & ""&quot>0;"
Set rs = db.OpenRecordset(strSQL)
l = 0
'test for empty record set
If Not rs.BOF Then
rs.MoveLast
rs.MoveFirst
l = rs.RecordCount
End If
If l > 0 Then
Do While Not rs.EOF
j = Len(pString)
namefix = rs(namehold)
Do While InStr(namefix, pString) > 0
k = 0
k = InStr(namefix, pString)
lefthold = Left(namefix, k - 1) & pRepwith
righthold = RTrim(Mid(namefix, k + j))
namefix = lefthold & righthold
Loop
'test for field length
If typehold = 12 Or Len(namefix) <= lenhold Then
'12 = memo field
rs.Edit
rs(namehold) = namefix
rs.Update
End If
rs.MoveNext
Loop
End If

End If

Next n

rs.Close
db.Close
Set db = Nothing

End Function

 

[MichaelRed]

The &quot;Split&quot; function will do the actual replacement with a minimal ammount of code and no programmatic looping through the recordset.

In an UPDATE Query, place:


basStripDot([YourFieldNameHere])

and place the following in a PUBLIC / GENERAL Module

Public Function basStripDot()
    Dim Idx As Integer
    Dim MyVar As Variant
    Dim varTmp As Variant

    MyVar = Split(StrIn, ".")

    For Idx = 0 To UBound(MyVar)
        varTmp = varTmp & MyVar(Idx)
    Next Idx

    basStripDot = varTmp

End Function

MichaelRed
redmsp@erols.com

There is never time to do it right but there is always time to do it over