Rich Text Find Replace Problems

[Elliot Fraval]

Hi All,

Environment is VBA code in Access 2007.

I am having some problems performing a find and replace on text that originates from a memo field in a table. The code is supposed to take internal document tracking numbers and replace them with simpler document number in reports for external clients, so the search string, or 'delimiter' is ~10 characters depending on document name.

I have used several methods involving the VBA functions: InStr; Split; and Replace. None reliably find the Search String within the test to be searched. ie. The find / replace methods work on some rich text fields, but not those that originate from memo fields.

I have tried passing variable ByVal into the find replace function, using String variables, both local and global, putting the text to be searched into text boxes on a form and processing them there before returning them to the table field and nothing I can see works.

Example memo text snippet:

"<div><strong>W at‐1.A.1: </strong>Complete d calculator. The shower usage calculation is adjusted according to bla bla bla.<br><strong >Wat‐1.A.2: </strong>drawings showing all installed fixtures</div>"

Searching for "Wat‐1.A.1"
Replacing with "Wat-1.1"

Example of function used to find replace:

Public Function FindReplace(ByVal fStr, ByVal rStr, ByVal sStr As String) As String
    
    Dim varSplit As Variant
    Dim i As Integer
    
    If fStr = rStr Then
        Exit Function
    End If
    
    
    Do While InStr(1, sStr, fStr, 1) <> 0
        
        varSplit = Split(sStr, fStr)
        
        sStr = varSplit(0) & rStr & varSplit(1)
        i = i + 1
    Loop
    
    Debug.Print ("Number of replacements: " & i & ". Search String: " & fStr)
    
    FindReplace = sStr
    
End Function

Or with a different function via text boxes on form:

Public Function FR_vForm(ByVal fStr, ByVal rStr, ByVal sStr As String)

Dim i As Integer
Dim tStr As String

tStr = ""

With Forms![Cover Sheet Generator]

    .text_search = sStr
    .text_find = fStr
    .text_replace = rStr
    i = 0
    Do While .text_search <> tStr
        tStr = .text_search
        .text_search = Replace(.text_search, fStr, rStr)
        i = i + 1
    Loop


    .text_output = FindReplace(fStr, rStr, sStr)
    FR_vForm = .text_search
End With

End Function

Similarly the InStr function always returned 0 even when it was clear that there was more than one occurance of the search string within th text to be searched.

[mshmyob]

Just subscribing.

Will check back in tomorrow if you get no response by then.

cheers,

[mshmyob]

Ok here is a way to replace a string in a memo field using recordsets.

Code for the form:

Dim strOrig As String
Dim strAltered As String
Dim strOld As String
Dim strNew As String

Set rst = Me.RecordsetClone

rst.MoveFirst
' ------ put code in here to find the record you want -----

' once you have moved to the proper record then do the following to replace a string in a memo field


' the memo field you want to look in for the string
strOrig = rst.DataMemo
'the string you want to replace
strOld = "Wat-1.A.1"
'what you want to put in place of the old string
strNew = "Wat-1-A-1"
'call the function to search and replace
strAltered = fSearchReplace(strOrig, strOld, strNew)
' update the memo field
' set the recordset into edit mode
rst.Edit
' replace the memo field with the new data
rst.DataMemo = strAltered
' update the recordset and close it
rst.Update
rst.Close

Code for the module:

Public Function fSearchReplace(strOrig As String, strOld As String, strNew As String)
Dim intCount As Integer

strAltered = ""

For intCount = 1 To Len(strOrig)
    If Mid(strOrig, intCount, Len(strOld)) = strOld Then
        strAltered = strAltered & strNew
        intCount = intCount + (Len(strOld) - 1)
    Else
        strAltered = strAltered & Mid(strOrig, intCount, 1)
    End If
Next intCount
    fSearchReplace = strAltered
End Function

If you have any questions please ask.

cheers,

[Elliot Fraval]

Thanks for your help mshmyob.

Unfortunately it still doesn't work!!!! I made a little mod to your code to add some debugging, so here is the code and output:

Public Function fSearchReplace(ByVal strOrig As String, ByVal strOld As String, ByVal strNew As String)
Dim intCount As Integer
Dim strAltered, test As String

strAltered = ""

For intCount = 1 To Len(strOrig)
    
    If strOld = "Wat-1.A.1" Then
        test = Mid(strOrig, intCount, Len(strOld))
        Debug.Print ("'" & test & "'  Looking for: " & strOld & " StrCmp output: " & StrComp(test, strOld, 0))
        
    End If
    
    If Mid(strOrig, intCount, Len(strOld)) = strOld Then
        Debug.Print ("replacement made")
        strAltered = strAltered & strNew
        intCount = intCount + (Len(strOld) - 1)
    Else
        strAltered = strAltered & Mid(strOrig, intCount, 1)
    End If
Next intCount
    fSearchReplace = strAltered
End Function

The debug.print output is as follows as it parses a text region containing rich text formatting around the search string. Note that the StrComp function never returns 0 despite the strings matching exactly as far as I can see. I have tried to change the comparison method, and use functions such as UCase on both strings to try to get a mach. No dice.

'rong>Wat-' Looking for: Wat-1.A.1 StrCmp output: 1
'ong>Wat-1' Looking for: Wat-1.A.1 StrCmp output: 1
'ng>Wat-1.' Looking for: Wat-1.A.1 StrCmp output: 1
'g>Wat-1.A' Looking for: Wat-1.A.1 StrCmp output: 1
'>Wat-1.A.' Looking for: Wat-1.A.1 StrCmp output: -1
'Wat-1.A.1' Looking for: Wat-1.A.1 StrCmp output: 1
'at-1.A.1:' Looking for: Wat-1.A.1 StrCmp output: 1
't-1.A.1: ' Looking for: Wat-1.A.1 StrCmp output: 1

I canot see any reason why these two strings are unequal, however StrComp, InStr, Split and Replace cannot match the string.

Again, the method worked fine on the non field derived text field.

I am at a complete loss on this.

Cheers,

Elliot

[mshmyob]

Could you attach the form and the table so I can look at it and maybe I can spot something. I use the code I supplied all the time and it works (even on RTF memo fields), so I am at a loss until I see the complete steps you are taking.

cheers,