View Single Post
  #2   Report Post  
Posted to microsoft.public.word.docmanagement
Jay Freedman Jay Freedman is offline
external usenet poster
 
Posts: 9,854
Default Looping Macro for Selection String Between Quotation Marks

Hi Rod,

Unfortunately, this is one of those situations where the macro recorder leads
you badly astray. Because it can only use the Selection object (corresponding to
the physical cursor in the document), it has to do the Activate to jump from
document to document. In the process, it tends to lose track of what properties
are set for the Find. Complicating that, you've put the Do While statement in
the wrong place, so the Find is only done once.

Here's a version that works. The document that receives the copies of the quoted
text is a new blank one created by the Documents.Add statement; that can be
changed if necessary.

Sub demo()
Dim Doc1 As Document, Doc2 As Document
Dim oRg1 As Range, oRg2 As Range

Set Doc1 = ActiveDocument
Set Doc2 = Documents.Add

Set oRg1 = Doc1.Content

With oRg1.Find
.Text = """"
.Forward = True
.Format = False
.Wrap = wdFindStop
Do While .Execute
' oRg1 points to starting quote
' extend it to include the ending quote
oRg1.MoveEndUntil Cset:="""", Count:=wdForward
oRg1.MoveEnd Unit:=wdCharacter, Count:=1

' point oRg2 to the end of Doc2
Set oRg2 = Doc2.Content
oRg2.Collapse Direction:=wdCollapseEnd

' "copy" without using clipboard
oRg2.FormattedText = oRg1.FormattedText

' add a paragraph mark at the end
oRg2.Collapse Direction:=wdCollapseEnd
oRg2.Text = vbCr

' prepare to find next pair of quotes
oRg1.Collapse Direction:=wdCollapseEnd
Loop
End With
End Sub


--
Regards,
Jay Freedman
Microsoft Word MVP FAQ: http://word.mvps.org
Email cannot be acknowledged; please post all follow-ups to the newsgroup so all
may benefit.

On Mon, 4 Aug 2008 13:46:43 -0700, RPMitchal
wrote:

Word 2003

I have attempted to put together the below looping macro which essentially
searches for a word or words surrounded by quotation marks in Document (2),

selects everything between and including the opening and closing quotation
marks by using the "Extend" feature (F8);

copies the selected string and pastes it at the cursor position in Document
(1);

inserts a paragraph return; and

then switches back to Document (2), advances past the highlighted selection
and repeats the same functions until reaching the end of the document.

The macro seems to work just fine until such time as I insert the "Do While"
and the "Loop" commands in an attempt to get the macro to repeat itself until
reaching the end of the document.

Obviously, I am missing at the very least – one step - and would very much
appreciate any assistance or insight into what I am doing incorrectly. If
the below macro is completely off the mark, I would appreciate being
furnished with the coding for a macro that actually would work and how me the
errors of my ways.

Thanks – Rod

Sub Definition()
'
' Definition Macro
' Macro recorded 7/31/2008 by Rod
'
Selection.Find.ClearFormatting
With Selection.Find
.Text = """"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
Selection.Extend
Selection.Find.ClearFormatting
With Selection.Find
.Text = """"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindAsk
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Do While Selection.Find.Execute
Selection.Copy
Windows(1).Activate
Selection.PasteAndFormat (wdPasteDefault)
Selection.TypeParagraph
Windows(2).Activate
Selection.MoveRight Unit:=wdWord, Count:=1
Loop

End Sub