Solved

vb6 and MsWord - Replace bookmark or text with RTF formatted text

Posted on 2014-04-07
4
461 Views
Last Modified: 2014-04-18
Hi Guys

looking at the following code - how would I replace some text with a formatted RTF string (taken from a RichEdit Control) - ie the variable sReplace is a preformatted RTF string.

Private Function FindReplaceAnywhere(strFind As String, sReplace As String, Optional iMode As Integer = 0)
 'On Error GoTo ErrHandler:
    Dim rngStoryType As Word.Range
    Dim rngCurrentStory As Word.Range
    Dim bFound As Boolean
    If Len(sReplace) > 250 Then
            With wrdApp.Selection.Find
                .ClearFormatting
                .Text = strFind
                .Replacement.Text = ""
                .Wrap = wdFindContinue
                .Execute
            End With
            With wrdApp.Selection
                If .Find.Found Then
                    .TypeText sReplace
                End If
            End With
    Else
        For Each rngStoryType In wordDoc.StoryRanges ' refer to our current and opened word document
            Set rngCurrentStory = rngStoryType 'set rngCurrentStory to first range in story
            Do
                bFound = FindAndReplaceInRange(rngCurrentStory, strFind, sReplace, iMode)

                If bFound And iMode = 1 Then Exit Do

                Set rngCurrentStory = rngCurrentStory.NextStoryRange
            Loop Until rngCurrentStory Is Nothing
        Next rngStoryType
    End If
NoError:

    Exit Function
ErrHandler:
    
        Call ClsErrorHandler("FindReplaceAnywhere", "", True, False)
        GoTo NoError


End Function

Private Function FindAndReplaceInRange(rng As Word.Range, strFind As String, sReplace As String, Optional iMode As Integer = 0)
 On Error GoTo ErrHandler:
    With rng.Find
        .Text = strFind
        With .Replacement
            .ClearFormatting
            .Text = Left(sReplace, 255)
        End With
        If iMode = 1 Then
           .Execute Replace:=Word.WdReplace.wdReplaceOne
        Else
           .Execute Replace:=Word.WdReplace.wdReplaceAll
        End If
    End With
    FindAndReplaceInRange = rng.Find.Found
NoError:

    Exit Function
ErrHandler:
    
        Call ClsErrorHandler("FindAndReplaceInRange", "", True, False)
        GoTo NoError

End Function

Open in new window


MTIA

DWE
0
Comment
Question by:dwe0608
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 3
4 Comments
 
LVL 51

Expert Comment

by:Rgonzo1971
ID: 39982480
Hi,

You could save it as a File and then insert it in Word

RichTextBox1.SaveFile, myFilename, rtfRTF
Word.Selection.InsertFile myFilename 

Open in new window

Regards
0
 
LVL 1

Author Comment

by:dwe0608
ID: 39984225
yes, I am aware of that ... but before implementing that, I need to properly investigate the alternatives ..
0
 
LVL 1

Accepted Solution

by:
dwe0608 earned 0 total points
ID: 39984823
ok - heres how I did it ... basically I opted for the clipboard technique described in an MS KB Article found here

insert the following decs in the top of the form
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 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 Const GMEM_DDESHARE = &H2000
Private Const GMEM_MOVEABLE = &H2

Open in new window


and Modified my function as follows


Private Function RTFCopy(sRTF As String) As Long
    'Copy the contents of the Rich Text to the clipboard
    Dim lSuccess As Long
    Dim lRTF As Long
    Dim hGlobal As Long
    Dim lpString As Long
    
    lSuccess = OpenClipboard(UserControl.Parent.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

End Function

Private Function FindReplaceAnywhere(strFind As String, sReplace As String, Optional iMode As Integer = 0, Optional IsRTF As Boolean = False)
 'On Error GoTo ErrHandler:
    Dim rngStoryType As Word.Range
    Dim rngCurrentStory As Word.Range
    Dim bFound As Boolean
    If Len(sReplace) > 250 Then
            With wrdApp.Selection.Find
                .ClearFormatting
                .Text = strFind
                .Replacement.Text = ""
                .Wrap = wdFindContinue
                .Execute
            End With
            
            'just in case we cant set the IsRTF variable (I cant because my data is loaded string from the database into an array of fields and data)
            ' test the string to see if likely to be an RTF string
            ' it seems the first 5 characters of an RTF string are {\rtf
            Dim sResult As String
            Dim b As Integer
            sResult = Mid$(sReplace, 1, 5)
            b = StrComp(sResult, "{\rtf", vbTextCompare)
            
            If b = 0 Then IsRTF = True
            
            With wrdApp.Selection
                If .Find.Found Then
                    If Not IsRTF Then
                    .TypeText sReplace
                    Else
                    ' text should be on the clipboard
                    RTFCopy sReplace
                    .Paste
                    End If
                End If
            End With
    Else
        For Each rngStoryType In wordDoc.StoryRanges ' refer to our current and opened word document
            Set rngCurrentStory = rngStoryType 'set rngCurrentStory to first range in story
            Do
                bFound = FindAndReplaceInRange(rngCurrentStory, strFind, sReplace, iMode)

                If bFound And iMode = 1 Then Exit Do

                Set rngCurrentStory = rngCurrentStory.NextStoryRange
            Loop Until rngCurrentStory Is Nothing
        Next rngStoryType
    End If
NoError:

    Exit Function
ErrHandler:
    
        Call ClsErrorHandler("FindReplaceAnywhere", "", True, False)
        GoTo NoError


End Function

Private Function FindAndReplaceInRange(rng As Word.Range, strFind As String, sReplace As String, Optional iMode As Integer = 0)
 On Error GoTo ErrHandler:
    With rng.Find
        .Text = strFind
        With .Replacement
            .ClearFormatting
            .Text = Left(sReplace, 255)
            
        End With
        If iMode = 1 Then
           .Execute Replace:=Word.WdReplace.wdReplaceOne
        Else
           .Execute Replace:=Word.WdReplace.wdReplaceAll
        End If
    End With
    FindAndReplaceInRange = rng.Find.Found
NoError:

    Exit Function
ErrHandler:
    
        Call ClsErrorHandler("FindAndReplaceInRange", "", True, False)
        GoTo NoError

    
End Function

Open in new window


Can we improve this code?

One thing I would like to be able to do is make sure I dont interfere in any other applications clipboard data and as far as I can see, I obliterate that data - is that correct? Am I better to try and preserve the data already on the clipboard and then restore it at the end of the function? If so, how?

MTIA

DWE
0
 
LVL 1

Author Closing Comment

by:dwe0608
ID: 40008420
I resolved my own question and believe that leaving the answer I came up with may help someone else.
0

Featured Post

Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Preface: When I started this series, I used the term CommandBars because that is the Office Object class that it discusses. Unfortunately, when Microsoft introduced Office 2007, they replaced the standard Commandbar menus with "The Ribbon" and rem…
You can of course define an array to hold data that is of a particular type like an array of Strings to hold customer names or an array of Doubles to hold customer sales, but what do you do if you want to coordinate that data? This article describes…
In this video, we show how to convert an image-only PDF file into a PDF Searchable Image file, that is, a file with both the image (typically from scanning) and text, which is created in an automated fashion with Optical Character Recognition (OCR) …
This video walks the viewer through the process of creating envelopes and labels, with multiple names and addresses. Navigate to the “Start Mail Merge” button in the Mailings tab: Follow the step-by-step process until asked to find the address doc…

739 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question