Still celebrating National IT Professionals Day with 3 months of free Premium Membership. Use Code ITDAY17

x
?
Solved

VB6 - MSWord Find and Replace

Posted on 2014-04-01
18
Medium Priority
?
294 Views
Last Modified: 2014-04-06
Hi Guys,

Using the following code to find and replace certain strings in a MSWord Document from VB6.

Private Function FindReplaceAnywhere(strFind As String, sReplace As String, Optional iMode As Integer = 0)
    Dim rngStoryType As Word.Range
    Dim rngCurrentStory As Word.Range
      ' Go through all story ranges in the document, including shapes, headers, footers, text boxes footnotes
    ' headers & footers.
    For Each rngStoryType In ActiveDocument.StoryRanges
        Set rngCurrentStory = rngStoryType 'set rngCurrentStory to first range in story
        Do
            FindAndReplaceInRange rngCurrentStory, strFind, sReplace, iMode
            Set rngCurrentStory = rngCurrentStory.NextStoryRange
        Loop Until rngCurrentStory Is Nothing
    Next rngStoryType
End Function

Private Sub FindAndReplaceInRange(rng As Word.Range, strFind As String, sReplace As String, Optional iMode As Integer = 0)
    With rng.Find
        .Text = strFind
        
        With .Replacement
            .ClearFormatting
            .Text = sReplace
        End With
        
        If iMode = 1 Then
           .Execute Replace:=Word.WdReplace.wdReplaceOne
        Else
           .Execute Replace:=Word.WdReplace.wdReplaceAll
           
        End If
        
        
    End With
End Sub

Open in new window


The code throws an error if sReplace string is longer than 255 characters with an error saying the string parameter is too long.

        With .Replacement
            .ClearFormatting
            .Text = sReplace  ' error thrown here
        End With

How can I replace text with upto 5 or 6 pages of text?

MTIA

Regards

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
  • 9
  • 8
18 Comments
 
LVL 76

Expert Comment

by:GrahamSkan
ID: 39968845
You could do something like this:
Private Sub FindAndReplaceInRange(rng As Word.Range, strFind As String, sReplace As String, Optional iMode As Integer)
    Dim rng2 As Range
    If iMode = 1 Then
        With rng.Find
            .Text = strFind
            If .Execute() Then
                rng.Text = sReplace
            End If
        End With
    Else
        Set rng2 = rng.Duplicate
        With rng2.Find
            .Text = strFind
            Do While .Execute()
                rng2.Text = sReplace
                rng2.Collapse wdCollapseEnd
                rng2.End = rng.End
            Loop
        End With
    End If
End Sub

Open in new window

0
 
LVL 15

Expert Comment

by:DrTribos
ID: 39968851
Where does the replace text come from?  Is it a string that is already in the document?

If I understand you don't have a problem finding the text... perhaps you could:

Bookmark your replace text, use the find as normal then assign a range to the found text and then change the range text:

Range1.text = activedocument.bookmarks("replacetext").range.text
0
 
LVL 15

Expert Comment

by:DrTribos
ID: 39968856
Actually stick with Graham on this one... I'll watch on with my popcorn :-D
0
Concerto Cloud for Software Providers & ISVs

Can Concerto Cloud Services help you focus on evolving your application offerings, while delivering the best cloud experience to your customers? From DevOps to revenue models and customer support, the answer is yes!

Learn how Concerto can help you.

 
LVL 1

Author Comment

by:dwe0608
ID: 39970425
Well after a bit of scrounging this is what I cam up with:

Private Function FindReplaceAnywhere(strFind As String, sReplace As String, Optional iMode As Integer = 0)
    Dim rngStoryType As Word.Range
    Dim rngCurrentStory As Word.Range
    
    ' if we're a short field (< 255 chars) we go through all storyranges
    ' if we're longer than 255 chars - we wont want to me in a header or somewhere like that anyway
    ' so assume that we only have one large replacement to do 
    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
      ' Go through all story ranges in the document, including shapes, headers, footers, text boxes footnotes
      ' headers & footers.
        For Each rngStoryType In ActiveDocument.StoryRanges
            Set rngCurrentStory = rngStoryType 'set rngCurrentStory to first range in story
            Do
                FindAndReplaceInRange rngCurrentStory, strFind, sReplace, iMode
                Set rngCurrentStory = rngCurrentStory.NextStoryRange
            Loop Until rngCurrentStory Is Nothing
        Next rngStoryType
    End If

End Function

Private Sub FindAndReplaceInRange(rng As Word.Range, strFind As String, sReplace As String, Optional iMode As Integer = 0)
    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
End Sub

Open in new window


Can we improve on this?


Regards

DWE
0
 
LVL 15

Expert Comment

by:DrTribos
ID: 39970516
Looks cool.  I've not been able to test but reading through... the Function does not seem to use iMode... not sure if that should be added?

Also, if iMode = 1 then is it the case that you would like to exit the do loop in the function to save time iterating through any remaining story ranges?

HTH
0
 
LVL 15

Expert Comment

by:DrTribos
ID: 39970592
Oh, just a thought...
I don't know the nature of your document, how frequently this kind of update is required etc..  But if this will be a regular undertaking for each document then you might look at content controls to hold text that needs to change in the future.  
Content controls can allow you to lock blocks of text that would make unintentional editing more difficult and also accommodate difficulties in matching text if there are slight (or major) changes...
0
 
LVL 1

Author Comment

by:dwe0608
ID: 39970899
Hi DrTribos

Yes, iMode is referenced ...

Good point about exiting the do loop though ... but would happen if the change was only in a header? Sometimes without going through all the storys you dont find the text to replace in a header ... maybe test to see if it was found?
0
 
LVL 1

Author Comment

by:dwe0608
ID: 39970900
BTW good to see another Aussie on here :-)
0
 
LVL 1

Accepted Solution

by:
dwe0608 earned 0 total points
ID: 39970906
Updated code:

Private Function FindReplaceAnywhere(strFind As String, sReplace As String, Optional iMode As Integer = 0)
    Dim rngStoryType As Word.Range
    Dim rngCurrentStory As Word.Range
    Dim bFound As Boolean
    ' if we're a short field (< 255 chars) we go through all storyrages
    ' if we're longer than 255 chars - we wont want to me in a header or somewhere like that anyway
    ' so assume that we only have one large replacement to do anyway
    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
      ' Go through all story ranges in the document, including shapes, headers, footers, text boxes footnotes
      ' headers & footers.
        For Each rngStoryType In ActiveDocument.StoryRanges
            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

End Function

Private Function FindAndReplaceInRange(rng As Word.Range, strFind As String, sReplace As String, Optional iMode As Integer = 0)
    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
    
End Function

Open in new window


Can we improve this any more?
0
 
LVL 15

Expert Comment

by:DrTribos
ID: 39970908
Where are you based? I'm Sydney.  

Re the do loop - you can set boolean for each story that must be searched and only exit if the required booleans are all true.  

something like this... b1 = true, b2 = true

?b1 * b2 = 1
?b1 * b2 = 0   (if either or both are False)
0
 
LVL 15

Expert Comment

by:DrTribos
ID: 39970909
You were too quick for me
0
 
LVL 1

Author Comment

by:dwe0608
ID: 39970985
Rural Queensland ... Colinton ... about 140klms northwest of Ipswich Qld ...
0
 
LVL 15

Expert Comment

by:DrTribos
ID: 39970993
Nice - looks close enough to Brisb to get into town and far enough from the noise :-)
0
 
LVL 1

Author Comment

by:dwe0608
ID: 39971016
2.5hrs to Bris and yes, no noise ... except cows and horses and of course ... the wife ...
0
 
LVL 15

Expert Comment

by:DrTribos
ID: 39971021
lol - not sure where to take that... might leave it alone ;-)
0
 
LVL 1

Author Comment

by:dwe0608
ID: 39971027
lol ... nah the wifes good ... couldnt survive without her ...
thanks for the assistance ... keep an eye out for the next query ...
might close this query off ... is it right to accept my own comment as answer?
0
 
LVL 15

Expert Comment

by:DrTribos
ID: 39971055
Yes you can do that. The guidelines are herehere (thanks for asking).

In general if the comments helped (or would have helped if you figured it out yourself) then points should be awarded.

Will keep an eye out for the next question :-)
0
 
LVL 1

Author Closing Comment

by:dwe0608
ID: 39981047
no expert assistance in coding ...
0

Featured Post

Concerto Cloud for Software Providers & ISVs

Can Concerto Cloud Services help you focus on evolving your application offerings, while delivering the best cloud experience to your customers? From DevOps to revenue models and customer support, the answer is yes!

Learn how Concerto can help you.

Question has a verified solution.

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

This article describes a method of delivering Word templates for use in merging Access data to Word documents, that requires no computer knowledge on the part of the recipient -- the templates are saved in table fields, and are extracted and install…
This article shows how to get a list of available printers for display in a drop-down list, and then to use the selected printer to print an Access report or a Word document filled with Access data, using different syntax as needed for working with …
Learn how to create and modify your own paragraph styles in Microsoft Word. This can be helpful when wanting to make consistently referenced styles throughout a document or template.
This Experts Exchange video Micro Tutorial shows how to tell Microsoft Office that a word is NOT spelled correctly. Microsoft Office has a built-in, main dictionary that is shared by Office apps, including Excel, Outlook, PowerPoint, and Word. When …
Suggested Courses

715 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