NdNoviceHlp
Well-known Member
- Joined
- Nov 9, 2002
- Messages
- 3,639
From XL, I'm trying to search a summary document for a keyword, then copy the paragraph containing the keyword to another document.
I want to be able to do this for a variable amount of paragraphs. Currently, the following code finds the keyword in summary.doc (once) and then copies it to test.doc It's a start. I can't seem to find a way to select and copy the paragraph (even once). The keyword is always on line1 and the paragraph is always 4 lines if that helps? I'll appreciate any suggestions. Thanks. Dave
I want to be able to do this for a variable amount of paragraphs. Currently, the following code finds the keyword in summary.doc (once) and then copies it to test.doc It's a start. I can't seem to find a way to select and copy the paragraph (even once). The keyword is always on line1 and the paragraph is always 4 lines if that helps? I'll appreciate any suggestions. Thanks. Dave
Code:
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
With Wdapp.Selection.Find
.ClearFormatting
.Execute FindText:="seed", Format:=False, Forward:=True
'***line below errors
'.Expand Unit:=wdParagraph
End With
With Wdapp.Selection
.Range.Copy
End With
Wdapp.activedocument.Close savechanges:=True
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