Do...Loop and having macro go to beginning of document

[Mikel]

I am new to Word and VBA my current version is Word 97.
I have written a macro that searches a document for
specific text, when found it cuts the selection and pastes
it into a new document and saves the new document. I would
like this macro to go back to the beginning line of the
first document and do the find again until all projects
have been cut and pasted into their own document. The last
line will always have **** in it.


The macro is below.

Public Sub SelectionFind()
'Macro searchs document and selects then cuts text
'from top of document to **** then pastes it into
'another document and saves it.

Application.ScreenUpdating = False
' Turn on ExtendMode
Selection.ExtendMode = True

' Perform the search
With Selection.Find
.ClearFormatting
.Text = "****"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Execute

Selection.Expand wdLine
Selection.Cut
Documents.Add

Selection.Paste
'========================================================
'Saves and Renames New Document
'===================================================

'Show SaveAs dialog to allow user to save copy
With Dialogs(wdDialogFileSaveAs)
.Show
End With
End With

' Turn off ExtendMode
Selection.ExtendMode = False
Application.ScreenUpdating = True

End Sub

Thanks for any help you can provide,
Mikel

 

[Doug Robbins - Word MVP - DELETE UPPERCASE CHARACT]

The following code should do what you want:

Dim myrange As Range, newdoc As Document, source As Document
Set source = ActiveDocument
Selection.HomeKey wdStory
Selection.Find.ClearFormatting
With Selection.Find
Do While .Execute(FindText:="****", MatchWildcards:=False,
Wrap:=wdFindContinue, Forward:=True) = True
Set myrange = Selection.Range
myrange.Start = ActiveDocument.Range.Start
Set newdoc = Documents.Add
newdoc.Range.InsertAfter myrange
newdoc.Activate
Dialogs(wdDialogFileSaveAs).Show
newdoc.Close
source.Activate
myrange.Delete
Loop
End With

I haven't actually tested it and there's a chance that the Wrap should be
set to wdFindStop rather than wdFindContinue.

--
Please post any further questions or followup to the newsgroups for the
benefit of others who may be interested. Unsolicited questions forwarded
directly to me will only be answered on a paid consulting basis.

Hope this helps
Doug Robbins - Word MVP

 

[Mikel]

Doug,
Thank you very much! Your code works great. Is it
possible to have myrange to include the entire line when
it finds "****"? My original code used the
Selection.Expand wdLine to do this.
Thanks again, Mikel

 

[Mikel]

Thank you so much for your quick response and great help.

Fixed the code to work right after I sent the prior reply.
Duh!!! One last question, can I have the new document that
myrange is inserted into name the document with the first
8 characters of the first line? I am thinking I will need
to identify another range and set it to the first line or
first 8 characters of the new document. I am really lost
when it comes to ranges.

Mikel

 

[Doug Robbins - Word MVP - DELETE UPPERCASE CHARACT]

Declare a range object, then set it to the .Range of the new document, then
use

rangeobject.End = rangeobject.Start + 8

the rangeobject will then contain the name with which you want to save the
document.

--
Please post any further questions or followup to the newsgroups for the
benefit of others who may be interested. Unsolicited questions forwarded
directly to me will only be answered on a paid consulting basis.

Hope this helps
Doug Robbins - Word MVP