Removing font styles from Rich text (1 Viewer)

S

smig

Registered User.
Local time
Today, 14:13
Joined
Nov 25, 2009
Messages
2,209
How can I remove all Font Styles from a rich Text field in table.
I want to leave only the <B>, <U> and <I> styles

font styles will start with <Font.... > and end with </Font>
 
June7

June7

AWF VIP
Local time
Today, 03:13
Joined
Mar 9, 2014
Messages
5,470
This gets a little complicated because of the varied length of the FONT opening tag. Might need a custom function.

If you want to actually modify saved data, run an UPDATE action SQL.
 
Last edited:
S

smig

Registered User.
Local time
Today, 14:13
Joined
Nov 25, 2009
Messages
2,209
S

smig

Registered User.
Local time
Today, 14:13
Joined
Nov 25, 2009
Messages
2,209
June7 said:
This gets a little complicated because of the varied length of the FONT opening tag. Might need a custom function.

If you want to actually modify saved data, run an UPDATE action SQL.
Click to expand...
Thanks, as you noticed there is still more text to be removed after the first <Font...... till the enclosure with >
it can also be with Upper, Lower or mix characters.

So how do I catch it to replace?
 
M

Micron

AWF VIP
Local time
Today, 07:13
Joined
Oct 20, 2018
Messages
3,478
As noted, you seem to have an issue that will require a udf (user defined function). Something along the lines of (in English)

you'd need a list (array or recordset) of not-allowed values
find the beginning of a specific not-allowed font tag word; call that start for the moment
find the next ending tag character after start (>) and call that end
back up one character (start minus 1)
use Mid to get the string from the new start to end
use Replace to insert "" where string was
since you know the beginning not-allowed tag, you know the format of the ending tag
use Replace to remove the ending tag (it will remove all of them if you don't provide the count parameter)
loop to the next value
rinse and repeat

All that is off the top of my head and may not be thought out well enough.
You might find it faster to import the text into a code editor such as Notepadd++ and remove it manually.
 
C

CJ_London

Super Moderator
Staff member
Local time
Today, 12:13
Joined
Feb 19, 2013
Messages
16,607
perhaps something like

Code: 
dim s as string
dim e as long

e=instr(mystring,"<Font")

while e <>0

    s=mid(mystring,e,instr(e,mystring,">")-e+1)
    mystring=replace(mystring,s,"",1,1)
    mystring=replace(mystring,"</font>","",1,1)
    e=instr(mystring,"<Font")

wend
 
June7

June7

AWF VIP
Local time
Today, 03:13
Joined
Mar 9, 2014
Messages
5,470
Or:
Code: 
Public Function RemoveFont(strD As String) As String
Dim strA As String, strB As String
If InStr(strD, "<Font") > 0 Then
    strA = Left(strD, InStr(strD, "<Font") - 1)
    strB = Mid(strD, InStr(strD, "<Font"))
    strB = Replace(Mid(strB, InStr(strB, ">") + 1), "</Font>", "")
End If
RemoveFont = strA & strB
End Function
 
M

Micron

AWF VIP
Local time
Today, 07:13
Joined
Oct 20, 2018
Messages
3,478
Hmm, why was I thinking that some font attributes needed to be kept (maybe like Size)? Dumb...
I searched the smilie tags and there isn't one for 'dunce'.
 
arnelgp

arnelgp

..forever waiting... waiting for jellybean!
Local time
Today, 19:13
Joined
May 7, 2009
Messages
19,234
still, RegExp can remove any RichText Tags.
to remove the Font tag:

anotherTextbox = RemoveRichTextTag(Me.theRichTextbox, "font")

to remove the Div and the Font tag:

anotherTextbox = RemoveRichTextTag(Me.theRichTextbox, "font", "div") 'you can interchange the font/div.

copy in a new Module:
Code: 
Public Function RemoveRichTextTag(ByVal pRichText As String, ParamArray pTagName() As Variant) As Variant
    Dim sPattern As String, v As Variant
    If Trim(pRichText & "") = "" Then Exit Function
    With CreateObject("VBScript.RegExp")
        .Global = True
        .IgnoreCase = True
        For Each v In pTagName
            sPattern = "<" & v & "[^><]*>|<." & v & "[^><]*>"
            .Pattern = sPattern
            'Debug.Print .TEST(pRichText)
            pRichText = .Replace(pRichText, "")
        Next
    End With
    RemoveRichTextTag = pRichText
End Function
 
S

smig

Registered User.
Local time
Today, 14:13
Joined
Nov 25, 2009
Messages
2,209
arnelgp said:
still, RegExp can remove any RichText Tags.
to remove the Font tag:

anotherTextbox = RemoveRichTextTag(Me.theRichTextbox, "font")

to remove the Div and the Font tag:

anotherTextbox = RemoveRichTextTag(Me.theRichTextbox, "font", "div") 'you can interchange the font/div.

copy in a new Module:
Code: 
Public Function RemoveRichTextTag(ByVal pRichText As String, ParamArray pTagName() As Variant) As Variant
    Dim sPattern As String, v As Variant
    If Trim(pRichText & "") = "" Then Exit Function
    With CreateObject("VBScript.RegExp")
        .Global = True
        .IgnoreCase = True
        For Each v In pTagName
            sPattern = "<" & v & "[^><]*>|<." & v & "[^><]*>"
            .Pattern = sPattern
            'Debug.Print .TEST(pRichText)
            pRichText = .Replace(pRichText, "")
        Next
    End With
    RemoveRichTextTag = pRichText
End Function
Click to expand...

Thank you

can you please explain me this:
sPattern = "<" & v & "[^><]*>|<." & v & "[^><]*>"

How will it find the </font> ?
also, can it deal the # that are part of the colors codes ?

What is the Div tag ?
 
S

smig

Registered User.
Local time
Today, 14:13
Joined
Nov 25, 2009
Messages
2,209
can I use an update query similar to this? It won't work as it is now.
UPDATE [Materials] SET [MaterialDescription] = Replace([MaterialDescription], '<FONT STYLE='BACKGROUND-COLOR:#FFFF00'>', '')

Problem is the string I'm looking for is <FONT STYLE='BACKGROUND-COLOR:#FFFF00'> which include both the ' and the # signs in it.
It will work if I use a recordset update, but as discussed in another thread is much more time consuming.
 
June7

June7

AWF VIP
Local time
Today, 03:13
Joined
Mar 9, 2014
Messages
5,470
Yes, and also eliminate the closing tag.

If you want to run a query object:
Code: 
UPDATE [Materials] SET [MaterialDescription] = Replace(Replace([MaterialDescription],"<FONT STYLE='BACKGROUND-COLOR:#FFFF00'>",""),"</FONT>","")
If you want to execute in VBA - note doubled apostrophes embedded in the string which escapes special character so it will be treated as normal text:
Code: 
CurrentDb.Execute "UPDATE [Materials] SET [MaterialDescription] = Replace(Replace([MaterialDescription],'<FONT STYLE=''BACKGROUND-COLOR:#FFFF00''>',''),'</FONT>','')"
 
Last edited:
arnelgp

arnelgp

..forever waiting... waiting for jellybean!
Local time
Today, 19:13
Joined
May 7, 2009
Messages
19,234
this is a modified version
Code: 
Public Function RemoveRichTextTag2(ByVal pRichText As String, ParamArray pTagName() As Variant) As Variant
    Dim sPattern As String, v As Variant
    Dim matches
    Dim i As Integer, j As Integer
    Dim l As Long
    Dim bolOK As Boolean
    If Trim(pRichText & "") = "" Then Exit Function
    With CreateObject("VBScript.RegExp")
        .Global = True
        .IgnoreCase = True
        For Each v In pTagName
            If InStr(v, "<Font") > 0 Then
                v = Replace(Replace(v, "<", ""), ">", "")
                sPattern = "<" & v & "[^><]*>|<.font[^><]*>"
            Else
                sPattern = "<" & v & "[^><]*>|<." & v & "[^><]*>"
            End If
            .Pattern = sPattern
            'Debug.Print .TEST(pRichText)
            Set matches = .Execute(pRichText)
            For i = 0 To matches.count - 1
                bolOK = False
                If matches(i) Like "<font*" Then
                    j = 1
                    bolOK = True
                Else
                    j = j + 1
                    If j < 3 Then
                        bolOK = True
                    End If
                End If
                If bolOK Then
                    l = InStr(1, pRichText, matches(i))
                    'Debug.Print matches(i)
                    pRichText = Left(pRichText, l - 1) & Mid(pRichText, l + Len(matches(i)))
                End If
            Next
        Next
    End With
    RemoveRichTextTag2 = pRichText
End Function

UPDATE [Materials] SET [MaterialDescription] = RemoveRichTextTag2([MaterialDescription], "<FONT STYLE='BACKGROUND-COLOR:#FFFF00'>")
 
S

smig

Registered User.
Local time
Today, 14:13
Joined
Nov 25, 2009
Messages
2,209
June7 said:
Yes, and also eliminate the closing tag.

If you want to run a query object:
Code: 
UPDATE [Materials] SET [MaterialDescription] = Replace(Replace([MaterialDescription],"<FONT STYLE='BACKGROUND-COLOR:#FFFF00'>",""),"</FONT>","")
If you want to execute in VBA - note doubled apostrophes embedded in the string which escapes special character so it will be treated as normal text:
Code: 
CurrentDb.Execute "UPDATE [Materials] SET [MaterialDescription] = Replace(Replace([MaterialDescription],'<FONT STYLE=''BACKGROUND-COLOR:#FFFF00''>',''),'</FONT>','')"
Click to expand...

Thanks
The doubled apostrophes did it :)
 
S

smig

Registered User.
Local time
Today, 14:13
Joined
Nov 25, 2009
Messages
2,209
arnelgp said:
this is a modified version
Code: 
Public Function RemoveRichTextTag2(ByVal pRichText As String, ParamArray pTagName() As Variant) As Variant
    Dim sPattern As String, v As Variant
    Dim matches
    Dim i As Integer, j As Integer
    Dim l As Long
    Dim bolOK As Boolean
    If Trim(pRichText & "") = "" Then Exit Function
    With CreateObject("VBScript.RegExp")
        .Global = True
        .IgnoreCase = True
        For Each v In pTagName
            If InStr(v, "<Font") > 0 Then
                v = Replace(Replace(v, "<", ""), ">", "")
                sPattern = "<" & v & "[^><]*>|<.font[^><]*>"
            Else
                sPattern = "<" & v & "[^><]*>|<." & v & "[^><]*>"
            End If
            .Pattern = sPattern
            'Debug.Print .TEST(pRichText)
            Set matches = .Execute(pRichText)
            For i = 0 To matches.count - 1
                bolOK = False
                If matches(i) Like "<font*" Then
                    j = 1
                    bolOK = True
                Else
                    j = j + 1
                    If j < 3 Then
                        bolOK = True
                    End If
                End If
                If bolOK Then
                    l = InStr(1, pRichText, matches(i))
                    'Debug.Print matches(i)
                    pRichText = Left(pRichText, l - 1) & Mid(pRichText, l + Len(matches(i)))
                End If
            Next
        Next
    End With
    RemoveRichTextTag2 = pRichText
End Function

UPDATE [Materials] SET [MaterialDescription] = RemoveRichTextTag2([MaterialDescription], "<FONT STYLE='BACKGROUND-COLOR:#FFFF00'>")
Click to expand...

Thanks a lot :)
I'll test it and dig into it
 
You must log in or register to reply here.

Similar threads

P
Remove font face RTF tags
Replies
10
Views
323
pdanes
P
M
E-mail hyperlinks not working from a table ...
Replies
6
Views
352
Marshall Brooks
M
J
Copy all code from one Access db to another
Replies
10
Views
346
isladogs
isladogs
I
Looping through 2 recordsets
Replies
5
Views
378
Indigo
I
M
Solved VBA to set USERFORM comboBox from SQL
3 4 5
Replies
89
Views
3,065
Marshall Brooks
M

Users who are viewing this thread

Total: 1 (members: 0, guests: 1)
Top Bottom