Hot to parse RTF String

[Robert Mileski]

Hi,

I have a question.

I want to put a string through VBA in Word, which has a "RTF Syntax" in a
Word document, but parsed, that is formatted.

I'll give you an example:

Sub ParseRTF()
Dim txtStr as String

txtStr = "{\rtf1\ansi\ansicpg1252\deff0{\fonttbl{\f0\fnil\fcharset0
MS Sans Serif;}}\viewkind4\uc1\pard\lang1031\b\f0\fs17 This is an example of
a String in RTF Format\par }"

End Sub


So, now I have a String with RTF. The problem is now, how can I put this
text in a Word Document, but it should be pasted already formated, not just
as a plain text.

One way of doing this, is putting the String in a .rtf File, and then using
this command: Selection.InsertFile FileName:="C:\TEST.rtf", Link:=True


But I don't want to use a file, because of the time doing a disk read. I
want to paste the formatted string in the document directly.


I want to do this, because I have an MS Access Database, where I store the
RTF Strings in Memo Fields. I want to read them from the database, and
formatted, put them in a document.


Every help will be much appreciated.


Best Regards,
Robert Mileski

 

[Peter Jamieson]

You can try putting your RTF text on the clipboard and inserting it from
there.

This is some sample code that may help but I'm no expert in this field and
the code hasn't been subjected to much testing.

You'll need to fix the long lines when you copy into the VBA Editor.

Peter Jamieson

Public Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As
Long
Public Declare Function SetClipboardData Lib "user32" (ByVal wFormat As
Long, _
ByVal hMem As Long) As Long
Public Declare Function CloseClipboard Lib "user32" () As Long
Public Declare Function EmptyClipboard Lib "user32" () As Long
Public Declare Function RegisterClipboardFormat Lib "user32" Alias
"RegisterClipboardFormatA" (ByVal lpString As String) As Long
Public Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, _
ByVal dwBytes As Long) As Long
Public Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As
Long
Public Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As
Long
Public Declare Function GetFocus Lib "user32" () As Long
Public Declare Function lstrcpy Lib "kernel32" Alias "lstrcpyA" (ByVal hMem
As Long, _
ByVal lpString2 As String) As Long
Public Const GMEM_ZEROINIT = &H40


Function CopyRTFToClipboard(rtext As String) As Boolean


' Returns true if it managed to put the data in the clipboard, false
otherwise
' - error checking is incomplete in this routine
' For the subsequent paste operation to work correctly the rtext must be
Valid RTF
' If the text you have is not correctly wrapped up then you should add some
Code
' to wrap it in e.g. something like the minimal rtf wrapper
{\rtf1\ansi{<<your rtf>>}}


Dim hwnd As Long ' calling window
Dim hBuf As Long ' globalalloc buffer handle
Dim hMem As Long ' globalalloc buffer location
Dim j As Long ' junk
Dim r As Long ' registered format number


CopyRTFToClipboard = False
rtext = Trim(rtext)
' If we have something rtf-like to Copy...
Debug.Print Left(rtext, 6) & Right(rtext, 1)
If Left(rtext, 6) = "{\rtf1" And Right(rtext, 1) = "}" Then


' Get a handle to the active Window (not convinced this is needed).
hwnd = GetFocus


' Open the clipboard, clear, put the data in, close


If (OpenClipboard(hwnd) <> 0) Then


EmptyClipboard


' Register the RTF format name
r = RegisterClipboardFormat("Rich Text Format")


' NULL-terminate the RTF string
rtext = rtext + Chr(0)


' allocate and lock the buffer, copy the data, unlock the buffer
' it is the responsibility of the clipboard to free this buffer


hBuf = GlobalAlloc(GMEM_ZEROINIT, Len(rtext))
If hBuf <> 0 Then
hMem = GlobalLock(hBuf)
hMem = lstrcpy(hMem, rtext)
GlobalUnlock (hBuf)


' put the data into the clipboard
j = SetClipboardData(r, hBuf)
CopyRTFToClipboard = True
End If
j = CloseClipboard()
End If
End If
End Function


Sub try()
Dim i As Long
Dim s As String
s = "{\rtf1\ansi\ansicpg1252\deff0{\fonttbl{\f0\fnil\fcharset0 MS Sans
Serif;}}\viewkind4\uc1\pard\lang1031\b\f0\fs17 This is an example of a
String in RTF Format\par }"
If CopyRTFToClipboard(s) Then Selection.Paste
End Sub