Word Macro Loop Keeps Looping

[michaelfaulkner]

This macro will loop through a mail merged document, but will not stop the loop at the end of file. Most of the code is searching, replacing and editing the form letters. The last block is formatting the page margins, etc.

Sub Prefetch_Test()
'
' Prefetch_Test Macro
' Macro recorded 07/14/2005 by Susan Milburn
'
Do Until ActiveDocument.Bookmarks("\Sel") = _
ActiveDocument.Bookmarks("\EndOfDoc")
Selection.Find.ClearFormatting

'begin search and replace/editing

With Selection.Find
.Text = "com-"
.Replacement.Text = "303-492-6301. "
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
Selection.MoveLeft Unit:=wdCharacter, Count:=1
Selection.MoveRight Unit:=wdCharacter, Count:=3
Selection.Delete Unit:=wdCharacter, Count:=1
Selection.Delete Unit:=wdCharacter, Count:=1
Selection.MoveDown Unit:=wdLine, Count:=1
Selection.Delete Unit:=wdCharacter, Count:=1
Selection.TypeText Text:=" "
ActiveWindow.ActivePane.SmallScroll Down:=26
Selection.Find.ClearFormatting
With Selection.Find
.Text = "be mailed"
.Replacement.Text = "303-492-6301. "
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.Delete Unit:=wdCharacter, Count:=1
Selection.TypeText Text:=" "
Selection.MoveDown Unit:=wdLine, Count:=1
Selection.Delete Unit:=wdCharacter, Count:=1
Selection.TypeText Text:=" "
Selection.MoveDown Unit:=wdLine, Count:=1
Selection.Delete Unit:=wdCharacter, Count:=1
Selection.TypeText Text:=" "
Selection.MoveDown Unit:=wdLine, Count:=1
Selection.Delete Unit:=wdCharacter, Count:=1
Selection.TypeText Text:=" "
Selection.MoveDown Unit:=wdLine, Count:=1
Selection.Delete Unit:=wdCharacter, Count:=1
Selection.TypeText Text:=" "
Selection.Find.ClearFormatting
With Selection.Find
.Text = "to us,"
.Replacement.Text = "303-492-6301. "
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.Delete Unit:=wdCharacter, Count:=1
Selection.TypeText Text:=" "
Selection.MoveDown Unit:=wdLine, Count:=1
Selection.TypeParagraph
;loop back to top while not end of file

Loop

;format page margins, etc.

With ActiveDocument.PageSetup
.LineNumbering.Active = False
.Orientation = wdOrientPortrait
.TopMargin = InchesToPoints(1.7)
.BottomMargin = InchesToPoints(1)
.LeftMargin = InchesToPoints(0.9)
.RightMargin = InchesToPoints(1)
.Gutter = InchesToPoints(0)
.HeaderDistance = InchesToPoints(1.5)
.FooterDistance = InchesToPoints(0.5)
.PageWidth = InchesToPoints(8.5)
.PageHeight = InchesToPoints(11)
.FirstPageTray = wdPrinterAutomaticSheetFeed
.OtherPagesTray = wdPrinterAutomaticSheetFeed
.SectionStart = wdSectionNewPage
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.VerticalAlignment = wdAlignVerticalTop
.SuppressEndnotes = False
.MirrorMargins = False
.TwoPagesOnOne = False
.BookFoldPrinting = False
.BookFoldRevPrinting = False
.BookFoldPrintingSheets = 1
.GutterPos = wdGutterPosLeft
End With
End Sub

 

[fumei]

Hi Michael, just a couple of pointers that may help.

1. Try and use With statements, For example, instead of:

    Selection.Find.Execute
    Selection.MoveLeft Unit:=wdCharacter, Count:=1
    Selection.MoveRight Unit:=wdCharacter, Count:=3
    Selection.Delete Unit:=wdCharacter, Count:=1
    Selection.Delete Unit:=wdCharacter, Count:=1
    Selection.MoveDown Unit:=wdLine, Count:=1
    Selection.Delete Unit:=wdCharacter, Count:=1
    Selection.TypeText Text:=" "[/code}

use:

With Selection
  .MoveLeft Unit:=wdCharacter, Count:=1
  .MoveRight Unit:=wdCharacter, Count:=3
  .Delete Unit:=wdCharacter, Count:=1
  .Delete Unit:=wdCharacter, Count:=1
  .MoveDown Unit:=wdLine, Count:=1
  .Delete Unit:=wdCharacter, Count:=1
  .TypeText Text:=" "
End With

It makes it easier to follow what you are doing.

2. Use some comments, which also makes it easier to follow what you are doing. As it is, I am having a hard time figuring out some things.

You move the Selection left, then right. Not sure why. You have a .Delete...then another .Delete. This is not efficient code.

3. You can make your search more efficient with a array and using the Execute method better. Something like:

Selection.HomeKey Unit:=wdStory
With Selection.Find
   Do While (.Execute(findtext:="com-", Forward:=True) = True) = True
  ----- then whatever it is you are doing
   Loop
End With

This moves the Selection to the start of the document, and finds every instance of "com-" then does whatever action you want.

If you made an array of your search text, then you can include that in the loop.

Dim var
Dim mySearch(2) As String
mySearch(0) = "com-"
mySearch(1) = "be mailed"
mySearch(2) = "to us"
Selection.HomeKey Unit:=wdStory
With Selection.Find
  For var = 1 to 3
   Do While (.Execute(findtext:=mySearch(var), Forward:=True) = True) = True
  ----- then whatever it is you are doing
   Loop
  Next
End With

That way it search and actions each item in the array. It only actions if .Execute = True IS True. Looks weird I know, but it is an effcient way of using Find.

Ok, I am still a bit confused with what you are actually doing with the Selection movement, and deletes.

Perhaps if you clarified that, there may be a simple way to ensure the actions perform correctly.



Gerry

 

[TonyJollans]

Hi michaelfaulkner,

I agree with Gerry that the code is hard to read - it looks like most of it was recorded. I also agree that if you described (in English) what you were trying to do it would help. Amongst other things, I note that you set a Replacement.Text and never do a Replace - are you trying to do a Replace?

As for your loop control - a couple of suggestions:[ul][li]When you do a Find, the Selection is never set to the end of the document so your loop control condition will never be true[/li][li]Having .Wrap = wdFindContinue on your Finds means that Word will automatically restart at the beginning again after reaching the end of the document - consider using wdFindStop and checking the result of the .Execute (see Gerry's examples)[/li][/ul]

Enjoy,
Tony

--------------------------------------------------------------------------------------------
We want to help you; help us to do it by reading this: Before you ask a question.
Excel VBA Training and more Help at VBAExpress[