Convert a string with RTF Format in it to a plain text string

[Linhardt]

I have search and search for this but cannot find a solution. I have a vba project in Word that takes a sql data that is nvarchar(MAX) and needs to put it as text on a word document. The problem I am having is with the (RichText) RTF formatting that is in it. I just need to show the plain text. Since VBA does not really have a clipboard functionality so to speak. I used the DataObject.SetText and get my string from the database. I cannot figure out how to change the format in the SetText so that it knows it is RTF. The intellisense when you type it out says DataObject.SetText(string, Format). But I cannot seem to get the syntax right to deal with the format part. Everytime I have tried it has a compile error.

Here the part of my code where I need to convert the data coming in with the RTF Format to just plain text. rs![Narrative].Value is my data value from SQL.

Dim resultNarrative as String
If ((IsNull(rs![Narrative].Value))) Then
resultNarrative = ""
Else
Dim DataOgj as New DataObect
DataObj.SetText(rs![Narrative].Value)
resultNarrative = DataObj.GetText
End If

This will set the resultNarrative to the DataObj text but it still has the RTF Format. I thought you could use the SetText and specify what format the data is in. But not sure. Thought it would be DataObj.SetText(rs![Narrative].Value, ???RTFFormat???)

But not sure what to put in as the for the ???RTFFormat??? part.

Can anyone give me some sort of solution to get just the text value of the data from SQL without having to parse all the RTF Format? A good example would be helpful. Spent the whole day on this and no results as of yet. :banghead: Any help would be appreciated.

[Frosty]

A couple of observations...
1. Dim statements located in a procedure are dimensioned regardless of whether the statement is within a logical construct. So having your Dim statement in the Else area of your IF...Else...End if construct does not save you memory space for the procedure. And it can make troubleshooting tricky, especially with your use of the New keyword. Which leads me to...

2. Using the New statement in conjunction with a Dim statement is generally not a good programming practice. The reason for this is because it causes the object to be created whenever it is referenced and not already created. This causes problems in troubleshooting, if the variable is destroyed by some external process (or error trapping)

Sub Demo
dim x As New MyDataObject
x.SomeProperty = "Hello"
Set x = Nothing
msgbox x.SomeProperty
End Sub
The above code (assuming the MyDataObject class had a "SomeProperty" string property) would not cause a run-time error, but in most cases you would prefer it to cause a run-time error i.e., if your object has fallen out of scope for some reason, you want to know there was a problem, not get a bunch of the default values for the new object-- same thing if you were iterating through a collection object-- do you want to return a .Count of 0, or do you want to know that your collection was destroyed?)

If the above explanation doesn't make sense (I don't know your experience level), then suffice it to say that it is better practice to separate out your Dim statements from your New statements, a la

Dim DataObj As DataObject
Set DataObj = New DataObject

Until the above explanation *does* make sense... at which point you can investigate using the New keyword when appropriate.

This, of course, also requires that you use things like Option Explicit in your modules.

At that point, maybe you will notice (which may or may not be an issue) that you have a spelling error in the code you described above (you dim "DataOgj" but you reference "DataObj" -- depending on how you've coded this, maybe that is your problem... or maybe it's just a typo because you didn't copy and paste the actual code you are using.

3. What do you mean VBA doesn't have clipboard functionality? You have the ability to copy things into the clipboard and paste things from the clipboard. It requires utilizing a range (so you may need to use blank document, hidden maybe) in order to manipulate data... but you can certainly use VBA to deal with the clipboard. If you really want to get fancy, there are ways to deal directly with the System clipboard from VBA, but you'll need some private declares to do so.

4. This is a personal note, but I'm really not a fan of extra parentheses.
If ((IsNull(rs![Narrative].Value))) Then...
is exactly the same as
If IsNull(rs![Narrative].Value) Then...
Except that one is a bit easier to read.

I can't really give you a good example for the proper RTFFormat parameter, because I don't have one off the top of my head and don't know the exact object you're working with. Some of your syntax suggests you are coding this from within Access, but maybe that's pseudo code, and not real code (DataObj.SetText(rs![Narrative].Value) is not a line of code that will work in VBA, to my knowledge, but if you were to post a sample bit of the string you're getting from your database, I might have a suggestion of how to proceed in a kludgey fashion (since I don't know the various methods available to the actual DataObject class, nor what library it's referring to... is it DAO, ADODB, etc). You should check the Help File and the Object Browser, and you may find the Format option you're looking for to quickly solve your problem.

If none of the above helps, then one brainstorm would be to take the "ugly" version of the text (with the RTF formatting in it) and put it into a newly created .rtf file, and then open that .file using Word (which would parse it out), and then take the .Text property of that new document's range, which would strip out all the RTF codes. That would be a bit klugey, but it would ultimately work.

To have the "real" solution, you need to describe a bit better what you're talking about in terms of a function that would work, what private libraries you are referencing in your code project in order to have DataObject available to your VBA code, etc.

Hope this helps.

[Linhardt]

Sorry for the bad code and errors. I am just a novice at coding VBA and was typing it fast instead of copying the exact code because I did not have the exact code at the time and I was trying to do from memory. In blue is where I was trying to use the dataobject like the clipboard to handle the formating. Below is the exact code but not all of it. This is done in MS Word and not in Access.


Option Explicit
Dim connectionString As String
Dim location As String

Public Sub GetIncidentNo()
connectionString = "Provider=sqloledb.1;data source=XXXX-2;Initial catalog=" & "XXXXXX" & ";User ID=XXXXX;Password=XXXX"

Dim incidentNo As String
Dim rs As Recordset
Dim resultNarrative As String
incidentNo = InputBox(Prompt:="GIR Incident Number:", Title:="ENTER GIR INCIDENT NUMBER", Default:="")

If (incidentNo <> "") Then

On Error GoTo Err_GetADORSP
Dim strSql As String
strSql = "Select * from vwGIRtoSHPXXX where IncidentNo='" & incidentNo & "'"

Dim cn As ADODB.Connection
Set cn = New ADODB.Connection
cn.Open connectionString
Set rs = New ADODB.Recordset
Dim DataObj As MSForms.DataObject
Set DataObj = New DataObject
rs.Open strSql, cn, adOpenStatic, adLockReadOnly
If ((IsNull(rs![Narrative].Value))) Then
resultNarrative = ""
Else
DataObj.SetText(rs![Narrative].Value)
resultNarrative = DataObj.SetText
'resultNarrative = rs![Narrative].Value
End If

ActiveDocument.FormFields("RptOff").result = IIf(IsNull(rs![ReportingAgentFullName].Value), "", rs![ReportingAgentFullName].Value)

GetNarrativeTable (resultNarrative)
location = IIf((IsNull(rs![CompanyName].Value)), "", rs![CompanyName].Value + ", ") & " " & IIf(IsNull((rs![Address1].Value)), "", rs![Address1].Value) & " " & IIf(IsNull((rs![Address2].Value)), "", rs![Address2].Value) & " " & IIf(IsNull((rs![Address3].Value)), "", rs![Address3].Value) & ", " & IIf(IsNull((rs![City].Value)), "", rs![City].Value) & ", " & IIf(IsNull((rs![State].Value)), "", rs![State].Value) & " " & IIf(IsNull((rs![PostalCode].Value)), "", rs![PostalCode].Value)
PopulateForm (rs![ID].Value)
End If
Set cn = Nothing
Set rs = Nothing
Exit Sub
Err_GetADORSP:
MsgBox "Error getting data, error #" & Err.Number & ", " & Err.Description

End Sub
Public Sub GetNarrativeTable(resultNarrative As String)

Dim Tb As Integer
Tb = ActiveDocument.Tables.Count
Dim Z As Integer
LUnlockForm ("shp-XXX")
With ActiveDocument.Tables(Tb)
If InStr(1, .Rows(1).Range.Text, "NARRATIVE") > 0 Then
ActiveDocument.Tables(Tb).Range.Select
Selection.MoveDown Unit:=wdLine, Count:=2
Selection.Text = resultNarrative
End If
End With

End Sub


I kind of see your idea of saving the string as an .rtf file then open it with Word, let it handle the rtf then extracting the text out and closing the word doc. Not sure how to do that exactly in code so would you have an example of how to do it? I really appreciate your assistance so far it has given me something to think about.

[Linhardt]

I think I have found out how to do the open word file and get the text. but having and issue with a permission denied error. Below is the code I used.


Function ParseRTF(strRTF As String) As String
Dim wdDoc As Word.Document 'Ref: Microsoft Word 11.0 Object Library'
Dim f As Integer 'Variable to store the file I/O number'
'File path for a temporary .rtf file'
Const strFileTemp = "C:\TempFile_ParseRTF.rtf"

'Obtain the next valid file I/O number'
f = FreeFile

'Open the temp file and save the RTF string in it'
Open strFileTemp For Output As #f
Print #f, strRTF
Close #f

'Open the .rtf file as a Word.Document'
Set wdDoc = GetObject(strFileTemp)

'Read the now parsed text from the Word.Document'
ParseRTF = wdDoc.Range.Text

'Delete the temporary .rtf file'
Kill strFileTemp

'Close the Word connection'
wdDoc.Close False
Set wdDoc = Nothing
End Function


The error comes on the line: ParseRTF = wdDoc.Range.Text
It is a #70 Error Permission Denied. I am using windows 7. Not sure if it is because Win7 is not allowing me access to that file, but I can go in there and and see it and open it. On that folder I have full control in my permissions. Or is it a problem because my original doc has a password protection on it and I unlock and lock it in my code. So when opening another temp word doc to store my string then grab the text is it making that tem word doc password protected too? I included the unlock before the actual creating and opening the temp word doc to see if it had an effect but it didn't. Very confused now.

[Linhardt]

I have tried this way as well where I am trying to do it via clipboard by parsing the string via the clsRTFParser class that was added.


Private Declare Function GlobalAlloc Lib "kernel32" _
(ByVal wFlags&, ByVal dwBytes As Long) As Long
Private Declare Function GlobalLock Lib "kernel32" _
(ByVal hMem As Long) As Long
Private Declare Function GlobalUnlock Lib "kernel32" _
(ByVal hMem As Long) As Long
Private Declare Function lstrcpy Lib "kernel32" _
(ByVal lpString1 As Any, ByVal lpString2 As Any) As Long

Private Declare Function OpenClipboard Lib "user32" _
(ByVal Hwnd As Long) As Long
Private Declare Function EmptyClipboard Lib "user32" () As Long
Private Declare Function RegisterClipboardFormat Lib "user32" Alias _
"RegisterClipboardFormatA" (ByVal lpString As String) As Long
Private Declare Function SetClipboardData Lib "user32" _
(ByVal wFormat As Long, ByVal hMem As Long) As Long
Private Declare Function CloseClipboard Lib "user32" () As Long

'---'

Dim wdDoc As Word.Document 'Ref: Microsoft Word 11.0 Object Library'

Private Sub Class_Initialize()
Set wdDoc = New Word.Document
End Sub

Private Sub Class_Terminate()
wdDoc.Close False
Set wdDoc = Nothing
End Sub

'---'

Private Function CopyRTF(strCopyString As String) As Boolean
Dim hGlobalMemory As Long
Dim lpGlobalMemory As Long
Dim hClipMemory As Long
Dim lngFormatRTF As Long

'Allocate and copy string to memory'
hGlobalMemory = GlobalAlloc(&H42, Len(strCopyString) + 1)
lpGlobalMemory = GlobalLock(hGlobalMemory)
lpGlobalMemory = lstrcpy(lpGlobalMemory, strCopyString)

'Unlock the memory and then copy to the clipboard'
If GlobalUnlock(hGlobalMemory) = 0 Then
If OpenClipboard(0&) <> 0 Then
Call EmptyClipboard

'Save the data as Rich Text Format'
lngFormatRTF = RegisterClipboardFormat("Rich Text Format")
hClipMemory = SetClipboardData(lngFormatRTF, hGlobalMemory)

CopyRTF = CBool(CloseClipboard)
End If
End If
End Function

'---'

Private Function PasteRTF() As String
Dim strOutput As String

'Paste the clipboard data to the wdDoc and read the plain text result'
wdDoc.Range.Paste
strOutput = wdDoc.Range.Text

'Get rid of the new lines at the beginning and end of the document'
strOutput = Left(strOutput, Len(strOutput) - 2)
strOutput = Right(strOutput, Len(strOutput) - 2)

PasteRTF = strOutput
End Function

'---'

Public Function ParseRTF(strRTF As String) As String
If CopyRTF(strRTF) Then
ParseRTF = PasteRTF
Else
ParseRTF = "Error in copying to clipboard"
End If
End Function



Then just calling it like below (Orange Text):

Public Sub GetIncidentNo()
connectionString = "Provider=sqloledb.1;data source=XXXXX;Initial catalog=" & "XXXXXX" & ";User ID=XXXXXX;Password=XXXXXX"
Dim incidentNo As String
Dim rs As Recordset
Dim resultNarrative As String
incidentNo = InputBox(Prompt:="GIR Incident Number:", Title:="ENTER GIR INCIDENT NUMBER", Default:="")
If (incidentNo <> "") Then

On Error GoTo Err_GetADORSP
Dim strSql As String
strSql = "Select * from vwGIRtoSHP325 where IncidentNo='" & incidentNo & "'"

Dim cn As ADODB.Connection
Set cn = New ADODB.Connection
cn.Open connectionString
Set rs = New ADODB.Recordset
'Create new instance of clsRTFParser'
Dim RTFParser As clsRTFParser
Set RTFParser = New clsRTFParser


rs.Open strSql, cn, adOpenStatic, adLockReadOnly
'Do While Not rs.EOF
If ((IsNull(rs![Narrative].Value))) Then
resultNarrative = ""
Else
resultNarrative = RTFParser.ParseRTF(CStr(rs![Narrative].Value))

End If

ActiveDocument.FormFields("RptOff").result = IIf(IsNull(rs![ReportingAgentFullName].Value), "", rs![ReportingAgentFullName].Value)



GetNarrativeTable (resultNarrative)
location = IIf((IsNull(rs![CompanyName].Value)), "", rs![CompanyName].Value + ", ") & " " & IIf(IsNull((rs![Address1].Value)), "", rs![Address1].Value) & " " & IIf(IsNull((rs![Address2].Value)), "", rs![Address2].Value) & " " & IIf(IsNull((rs![Address3].Value)), "", rs![Address3].Value) & ", " & IIf(IsNull((rs![City].Value)), "", rs![City].Value) & ", " & IIf(IsNull((rs![State].Value)), "", rs![State].Value) & " " & IIf(IsNull((rs![PostalCode].Value)), "", rs![PostalCode].Value)
PopulateForm (rs![ID].Value)
' rs.MoveNext
' Loop
End If
Set cn = Nothing
Set rs = Nothing
'cn.Close
'rs.Close


Exit Sub
Err_GetADORSP:
MsgBox "Error getting data, error #" & Err.Number & ", " & Err.Description

End Sub


The only issue I have is clRTFParser creates an instance of another document and it becomes the active document and when I get down to the area colored red above, the original document with the form fields is no longer the active document. Need to figure out how to close that doc that the clsRTFParser creates without saving it when I set the string resultNarrative equal to the parsed text and then continuing on with my orginal document to place the newly parsed text into its field.

[Frosty]

It looks like there are at least 3 ways to go if you use the RTFParser class (which is basically an encapsulated way of doing what I was talking about). Personally, I'd use that... since you're so close anyway with it (even if you don't understand everything its doing).

1. Set a variable to the active document before you create an instance of the class (you see in the initialize event of the class that a new document is created). Then after you've used the class, instead of the red line where you use ActiveDocument... reference your document variable.

Something like
Dim RTFParser As clsRTFParser
Dim oMyDoc As Document
Set oMyDoc = ActiveDocument
'*now* initialize the class
Set RTFParser = New clsRTFParser

2. OR -- right before the ActiveDocument line, add
Set RTFParser = Nothing
You'll see in the Terminate event of the class, that is where it closes the document it uses for the purpose of parsing.

3. OR -- modify the class, so that in the initialize event it instead opens a hidden document. You would do this by changing the line
Set wdDoc = New Word.Document
to
Set wdDoc = Word.Documents.Add(Visible:=False)

That would have it work on an invisible document (this would be my preferred method, although I'd have to test the class a bit to see if there is a reason why it has to be visible), which would mean it never becomes the ActiveDocument.

As you see, there are many options (and probably more than I just listed) on how to proceed. This is an interesting class, which I'm going to spend a little bit of time looking at. Thanks for finding that class-- do you have someone to attribute it to? You should probably mention them in the class, if they originally had an attribution.