i got this to find the first instance but couldn't get a loop working
Private Sub CommandButton1_Click()
Dim Wdapp As Object, Wdapp2 As Object
Dim MyData As DataObject, Bigstring As String
'finds and extracts paragraphs from summary.doc to test.doc
'identifies paragraphs by key word in 1st line
'copies paragraph to clipboard then transfer to test.doc
'variable # of paragraphs to copy/transfer
On Error GoTo Evlmsg1
Set Wdapp = CreateObject("Word.application")
Wdapp.ChangeFileOpenDirectory "c:\records\"
Wdapp.Documents.Open FileName:="summary.doc"
With Wdapp.ActiveDocument
.Range(0, .Characters.Count).Select
End With
'keyword "seed" eg
'this is what I changed, it finds one instance
With Wdapp.Selection
.ClearFormatting
.Find.Execute FindText:="seed", Format:=False, Forward:=True
If .Find.Found = True Then
.Expand Unit:=wdParagraph
.Range.Copy
End If
End With
Wdapp.ActiveDocument.Close savechanges:=False
'end of modified section
Returntocode:
On Error GoTo 0
Wdapp.Quit
Set Wdapp = Nothing
Set MyData = New DataObject
MyData.GetFromClipboard
Bigstring = MyData.GetText(1)
On Error GoTo Evlmsg2
Set Wdapp2 = CreateObject("Word.Application")
Wdapp2.ChangeFileOpenDirectory "c:\"
Wdapp2.Documents.Open FileName:="test.doc"
'use to initial clear test.doc
With Wdapp2.ActiveDocument
.Range(0, .Characters.Count).Delete
End With
With Wdapp2.ActiveDocument
.Content.InsertAfter Bigstring
End With
Wdapp2.ActiveDocument.Close savechanges:=True
Wdapp2.Quit
Set Wdapp2 = Nothing
Exit Sub
Evlmsg1:
MsgBox "error1"
GoTo Returntocode
Evlmsg2:
On Error GoTo 0
Wdapp2.Quit
Set Wdapp2 = Nothing
MsgBox "Error2"
End Sub
also which version of word are you working in? I'm doing this in 2003.