Solved

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

Posted on 2014-04-07
4
411 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
  • 3
4 Comments
 
LVL 48

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

Why You Should Analyze Threat Actor TTPs

After years of analyzing threat actor behavior, it’s become clear that at any given time there are specific tactics, techniques, and procedures (TTPs) that are particularly prevalent. By analyzing and understanding these TTPs, you can dramatically enhance your security program.

Join & Write a Comment

I'm writing to share my clumsy experience in using this elegant tool so you can avoid every stupid mistake I made. (I leave it to the authorities to decide if this deserves a place in the Knowledge archives.)  Now that I am on the other side of my l…
This is written from a 'VBA for MS Word' perspective, but I am sure it applies to most other MS Office components where VBA is used.  One thing that really bugs me is slow code, ESPECIALLY when it's mine!  In programming there are so many ways to…
This video shows the viewer how to set up and create Footnotes in their document. Click on the References tab: Select "Insert Footnote": Type in desired text:
This video walks the viewer through the process of creating Hyperlinks for the web and other documents. Select the "Insert" tab: Click "Hyperlink":  Type "http://" followed by a web address to reference a website or navigate to a document to ref…

757 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

Need Help in Real-Time?

Connect with top rated Experts

21 Experts available now in Live!

Get 1:1 Help Now