Insert RTF into WORD

[Deleco]

Hi All,

I have a database which contains RTF (rich text format) syntax in a field. I would like to take this RTF text and put it into a Word document and see what the RTF should look like not the Syntax it self.

For Example

Some bold text - Correct format

RTF Syntax stored in DB for text above in BOLD

{\*\pnseclvl7\pnlcrm\pnstart1\pnindent720\pnhang {\pntxtb (}{\pntxta )}}{\*\pnseclvl8\pnlcltr\pnstart1\pnindent720\pnhang {\pntxtb (}{\pntxta )}}{\*\pnseclvl9\pnlcrm\pnstart1\pnindent720\pnhang {\pntxtb (}{\pntxta )}}\pard\plain
\ql \li0\ri0\widctlpar\aspalpha\aspnum\faauto\adjustright\rin0\lin0\itap0 \fs24\lang2057\langfe1041\loch\af0\hich\af0\dbch\af11\cgrid\langnp2057\langfenp1041 {\b\insrsid8790951\charrsid8790951 \hich\af0\dbch\af11\loch\f0 Some text in Bold}{
\b\insrsid26331\charrsid8790951
\par }}

Has anyone got any ideas, cheers for any help in advance

Deleco

 

[bubba100]

First off there are usually more than one way to do most anything. Here is one way. I can't take credit for it myself.
This will take the richtext copy to the clipboard then open Word and paste the formatted text.

Place the following on the FORM. Note--Not all of this will be used.

Option Explicit


Private Declare Function OpenClipboard Lib "User32" (ByVal hwnd As Long) As Long
Private Declare Function RegisterClipboardFormat Lib "User32" Alias _
"RegisterClipboardFormatA" (ByVal lpString As String) As Long
Private Declare Function EmptyClipboard Lib "User32" () As Long
Private Declare Function CloseClipboard Lib "User32" () As Long
Private Declare Function SetClipboardData Lib "User32" ( _
ByVal wformat As Long, ByVal hMem As Long) As Long
Private Declare Function GetClipboardData Lib "User32" (ByVal wformat As _
Long) As Long
Private Declare Function GlobalAlloc Lib "kernel32" (ByVal wflags As Long, _
ByVal dwbytes As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
ByVal destination As Long, source As Any, ByVal length As Long)
Private Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalFree Lib "kernel32" ( _
ByVal hMem As Long) As Long
Private Declare Function lstrcpy Lib "kernel32" (ByVal lstring1 As Any, _
ByVal lstring2 As Any) As Long
'Private Const CF_OEMTEXT = 1
Private Const GHND = &O42
Private Const CF_TEXT = 1
Private Const MAXSIZE = 4096
Private Const GMEM_DDESHARE = &H2000
Private Const GMEM_MOVEABLE = &H2

Next add a command button on the form and place the following in the onclick as an event procedure. The Actxctl8 is a richtext control.

Dim sRTF As String
sRTF = Me!ActXCtl8
Dim lSuccess As Long
Dim lRtf As Long
Dim hGlobal As Long
Dim lpString As Long
lSuccess = OpenClipboard(Me.hwnd)
lRtf = RegisterClipboardFormat("Rich Text Format")
lSuccess = EmptyClipboard
hGlobal = GlobalAlloc(GMEM_MOVEABLE Or GMEM_DDESHARE, Len(sRTF))
lpString = GlobalLock(hGlobal)
CopyMemory lpString, ByVal sRTF, Len(sRTF)
GlobalUnlock hGlobal
SetClipboardData lRtf, hGlobal
CloseClipboard
GlobalFree hGlobal
Dim oWord As Object
Dim oDoc As Object
Set oWord = CreateObject("Word.Application")
Set oDoc = oWord.Documents.Add
oWord.Selection.Paste
oWord.Visible = True

 

[PHV]

And why not simply use a RichTextBox control ?

Hope This Help, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884

 

[Deleco]

Thanks for the advice.

I should have mentioned that i know i can use the RTB control.

As word can save as RTF and can open and import RTF files i thought that there might be an internal VBA function like the RichTextBoxControl.TextRTF function that would allow me to add the RTF syntax and it be converted automatically.

I thought that this would be a lot easier, is this at all possible?

Deleco

 

[bubba100]

Can you explain a little more of what you have and are trying to do? Because I understand clearly what you mean "converted automatically".

 

[bubba100]

Please disreguard my last post. This is what I "really" ment to say.

Can you explain a little more of what you have and are trying to do? Because I "don't" understand clearly what you mean "converted automatically".

 

[Deleco]

Basically i have this RTF syntax stored in a Database

{\*\pnseclvl7\pnlcrm\pnstart1\pnindent720\pnhang {\pntxtb (}{\pntxta )}}{\*\pnseclvl8\pnlcltr\pnstart1\pnindent720\pnhang {\pntxtb (}{\pntxta )}}{\*\pnseclvl9\pnlcrm\pnstart1\pnindent720\pnhang {\pntxtb (}{\pntxta )}}\pard\plain

I want to be able to do something like the following

selection.typetext rs.fields("RTFSyntax").value

and instead of the above syntax being added to the document i want Word to display what the syntax actually is.

For example Some text in bold

Hope that makes more sense.

I have got round the issue by creating a text file and pasting the RTF syntax into it. I then save the text file with the .rtf extension. I can then use the Word Import file feature and this imports the RTF displaying what is meat by the RTF syntax not the RTF syntax itself.

Pheeeee

http://wwwww!!!

If you get what i mean

Deleco

 

[bubba100]

Been there and tried that.
.Value-- brings Everything as you have found out.
.Text-- brings in the text only no formatting like bolding.

Place the next section in the General area of the Form. This is the same as I sent at first.

Option Compare Database
Option Explicit


Private Declare Function OpenClipboard Lib "User32" (ByVal hwnd As Long) As Long
Private Declare Function RegisterClipboardFormat Lib "User32" Alias _
"RegisterClipboardFormatA" (ByVal lpString As String) As Long
Private Declare Function EmptyClipboard Lib "User32" () As Long
Private Declare Function CloseClipboard Lib "User32" () As Long
Private Declare Function SetClipboardData Lib "User32" ( _
ByVal wformat As Long, ByVal hMem As Long) As Long
Private Declare Function GetClipboardData Lib "User32" (ByVal wformat As _
Long) As Long
Private Declare Function GlobalAlloc Lib "kernel32" (ByVal wflags As Long, _
ByVal dwbytes As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
ByVal destination As Long, source As Any, ByVal length As Long)
Private Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalFree Lib "kernel32" ( _
ByVal hMem As Long) As Long
Private Declare Function lstrcpy Lib "kernel32" (ByVal lstring1 As Any, _
ByVal lstring2 As Any) As Long
'Private Const CF_OEMTEXT = 1
Private Const GHND = &O42
Private Const CF_TEXT = 1
Private Const MAXSIZE = 4096
Private Const GMEM_DDESHARE = &H2000
Private Const GMEM_MOVEABLE = &H2


I have put the following on a command button on a form. You will notice that it uses the recordset method from a table to determine the information. It takes the value of the field copies it to the clipboard and then pastes it to Word. This will keep the formatted text and lose the richtext "stuff".

Dim RST As Recordset
Dim DBS As Database
Dim sRTF As String
Dim lSuccess As Long
Dim lRtf As Long
Dim hGlobal As Long
Dim lpString As Long
Dim oWord As Object
Dim oDoc As Object
Set oWord = CreateObject("Word.Application")
Set oDoc = oWord.Documents.Add
Set DBS = currentDB
Set RST = DBS.OpenRecordset("tblIFTAWord") ' the table name where the info is located
sRTF = RST![field1] '[field1] whatever the name is for the info
lSuccess = OpenClipboard(hwnd)
lRtf = RegisterClipboardFormat("Rich Text Format")
lSuccess = EmptyClipboard
hGlobal = GlobalAlloc(GMEM_MOVEABLE Or GMEM_DDESHARE, Len(sRTF))
lpString = GlobalLock(hGlobal)
CopyMemory lpString, ByVal sRTF, Len(sRTF)
GlobalUnlock hGlobal
SetClipboardData lRtf, hGlobal
CloseClipboard
GlobalFree hGlobal
oWord.Selection.Paste
oWord.Visible = True

 

[Deleco]

Thanks for all the advice. In the end i went for writing to and from a text file. This is what i ended up with incase anyone needs to do it in the future. It works a treat.

        Set objTxt = fs.CreateTextFile("c:\data\tempwrite.rtf", True)
        objTxt.Write rs.Fields(0).Value & "" 'RTF SYNTAX
        objTxt.Close
        Set objTxt = Nothing
        Set fs = Nothing
        
        Selection.InsertFile "c:\data\tempwrite.rtf"

Deleco