Solved

VB6 - MSWord Find and Replace

Posted on 2014-04-01
18
276 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
  • 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 14

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 14

Expert Comment

by:DrTribos
ID: 39968856
Actually stick with Graham on this one... I'll watch on with my popcorn :-D
0
 
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 14

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 14

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
Better Security Awareness With Threat Intelligence

See how one of the leading financial services organizations uses Recorded Future as part of a holistic threat intelligence program to promote security awareness and proactively and efficiently identify threats.

 
LVL 14

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 14

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 14

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 14

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 14

Expert Comment

by:DrTribos
ID: 39971055
Yes you can do that. The guidelines are here & here (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

How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

Join & Write a Comment

Nice table. Huge mess. Maybe this was something you created way back before you figured out tabs or a document you received from someone else. Either way, using the spacebar to separate the columns resulted in a mess. Trying to convert text to t…
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 where to find the word count, how to display it, and what it breaks down to in Microsoft Word.
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.

707 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

18 Experts available now in Live!

Get 1:1 Help Now