Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations strongm on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Export Rich Text Memo Field to Plain Text Values? 3

Status
Not open for further replies.

kjv1611

New member
Jul 9, 2003
10,758
US
I'm thinking along the lines of how in Excel, you can copy a range, and then paste special - values.

Is there any way I could write a VBA script (or even a manual proces) to export data saved in a rich text field to only a text field?

This is not for something I have to do for work. It's a database I built at my church. I haven't changed to it yet, but I have been wanting to set up our "sermon notes" field up in such a manner as that we could use rich text formatting in that field - so for bold, color, italics, bulleted lists, etc. Currently, when I take notes with the PC, I type up the notes in a Word document, and then copy them to a plain text memo field.

I'd like to use a rich text field, but I'd also like to be able to export the rich text values to plain text if/when I wanted/needed. So far it's never been requested, but I'm just trying to think ahead in case it were ever requested.

Thanks for any thoughts or suggestions

"But thanks be to God, which giveth us the victory through our Lord Jesus Christ." 1 Corinthians 15:57
 
Select stripRichText([Sermon]) as PlainSermon from someTable...

Code:
Public Function StripRichText(varText As Variant) As Variant
  Dim mMatchCollection As VBScript_RegExp_55.MatchCollection
  Dim m As VBScript_RegExp_55.Match
  If Not IsNull(varText) Then
    Set mMatchCollection = getMatchCollection(varText)
    'Debug.Print mMatchCollection.count
    If Not mMatchCollection Is Nothing Then
      For Each m In mMatchCollection
         varText = Replace(varText, m.Value, "")
      Next m
    End If
    StripRichText = varText
  End If
End Function
Private Function getMatchCollection(strWord As Variant) As VBScript_RegExp_55.MatchCollection
   'Need refernence to Microsoft VBscript regular expressions
   Dim objRegExp As VBScript_RegExp_55.RegExp
   Dim colMatches As VBScript_RegExp_55.MatchCollection
   Dim myPattern As String
    myPattern = "<[^>]+>"
  'Create a regular expression object.
   Set objRegExp = New RegExp
  'Set the pattern by using the Pattern property.
   objRegExp.pattern = myPattern
  'Set Case Insensitivity.
   objRegExp.IgnoreCase = False
  'Set global applicability.
   objRegExp.Global = True
  'Test whether the String can be compared.
   If (objRegExp.Test(strWord) = True) Then
     Set colMatches = objRegExp.Execute(strWord)   ' Execute search.
   End If
   Set getMatchCollection = colMatches
End Function

I thought it could be done simply with
Code:
Public Function RemoveRichText(varText As Variant) As Variant
  Dim rgx As New VBScript_RegExp_55.RegExp
  rgx.pattern = "<[^>]+>"
  varText = rgx.Replace(varText, " ")
End Function

but could not get that to replace all. I am not very smart with Regex. You need to add a reference.
 
MajP, did you try this ?
Code:
Public Function RemoveRichText(varText As Variant) As Variant
  Dim rgx As New VBScript_RegExp_55.RegExp
  rgx.Pattern = "<[^>]+>"
  [!]rgx.Global = True
  rgx.Multiline = True[/!]
  varText = rgx.Replace(varText, "")
End Function

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886
 
Thanks. Works for me with some added additions and some notes.
Code:
Public Function RemoveRichText(varText As Variant) As Variant
  'Need refernence to Microsoft VBscript regular expressions
  Dim rgx As New VBScript_RegExp_55.RegExp
  If Not IsNull(varText) Then
    rgx.pattern = "<[^>]+>"
    'Global: Sets a Boolean value or returns a Boolean value that indicates
    'whether a pattern must match all the occurrences in a whole search string,
    'or whether a pattern must match just the first occurrence
    rgx.Global = True
    'Multiline: enables the regular expression engine to handle an input string that consists
    'of multiple lines. It changes the interpretation of the ^ and $ language elements so that
    'they match the beginning and end of a line, instead of the beginning and end of the input string.
    rgx.Multiline = True
    varText = rgx.Replace(varText, "")
  End If
    RemoveRichText = varText
End Function
 
Rich Text fields were introduced with Access 2007 - which also introduced the Plaintext function, which does what it says on the tin ...
 
Thanks everyone for the input! strongm, THANK YOU THANK YOU for mentioning that function. I guess if I'd of just guessed at it and tried, I'd of gotten it, haha!

"But thanks be to God, which giveth us the victory through our Lord Jesus Christ." 1 Corinthians 15:57
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top