Transfer paragraph(s)

My first post to this site. Unfortunately I've already posted this same query @ Mr. Excel's site but it seems more likely that a post here would produce some results. From XL, I am trying to find a keyword in a summary document then copy the paragraph containing the keyword to another document. The number of paragraphs to be copied is variable. The code below finds the keyword "seed" in "summary.doc" (once only) and copies it to "test.doc". This is a start. If anyone is able to help with the how to's of copying all of the whole paragraphs containing "seed" in the summary document to the test document, I sure would appreciate it. 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

---

it looks like your missing a select statement. something like below. might need more tweeking but hopefully it works.

Code:

---

With Wdapp.Selection
.ClearFormatting
.Find.Execute FindText:="seed", Format:=False, Forward:=True
'***line below errors
'.Expand Unit:=wdParagraph
'<>
If .Find.Found Then
.Select
Selection.Expand Unit:=wdParagraph
End If
'</>
End With

---

Thanks sandan but that errorred out (object doesn't support method). I tried the following and now have a bad parameter error on the expand line. Any other suggestions? Dave

Code:

---

If Wdapp.Selection.Find.Found Then
  Wdapp.Selection.Expand Unit:=wdParagraph
  End If

---

i got this to find the first instance but couldn't get a loop working

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
'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.

Hi Dave,
I moved this thread to the Excel Help forum. It's tricky sometimes to find the right forum; but I believe your thread will be much better suited in this forum. :yes

Hi Dave,

I just wanted to post a link to the thread in the MrExcel forum as well. No worries about posting in both places, but it's nice when the link is provided so we can check if anyone has done any work in the other place. :yes

Thanks for the move and the link. Sandam...your efforts are greatly appreciated. Your code changes just don't want to work for me? Do your changes copy the whole paragraph? I'm using XL 2000 on XP. Dave

I just clicked what the problem is. have you added a reference to the Word Object library? Tools->References->Microsoft Word 9.0 Object Library. This will define the wdParagraph variable - and yes it does copy the whole paragraph.

still trying to figure out a way to loop the methods so that it does it for all occurences of the "seed" word.

My reference is set but it still wants to error with the object doesn't support this method etc now on the line ".ClearFormatting " in your code revision. Could the problem be a reference priority issue or is my old XL version the problem? Dave

To be honest I'm not sure. I'd try experimenting with early binding and getting away from using the Object object. so setting your objects to Word.Document. I'll give it a go and see where I get with it.

Code:

---

Dim Wdapp As New Word.Document, Wdapp2 As New Word.Document
 Dim MyData As DataObject, Bigstring As String
'And then use
Set Wdapp = Documents.Open("c:\records\summary.doc")

---

Just tried the code from the Mr. Excel post. After trying it I'm fairly certain its a reference issue. The wdParagraph variable should almost certainly be a part of the Word object library, even as far back as 2000. and you can do the search without clearformatting. Its not a hundred percent neccessary to search text.


'This also was a good one from the Mr. Excel post

Code:

---

Wdapp.Documents.Open FileName:="summary.doc" , ReadOnly:=True'<-set file to read only on open

---

sandam: See the Mr. Excel link. It was a reference issue this time. It was at your suggestion that I reviewed my settings. Thank you for your help. I'm making progress. As you will see by the link, it's not quite a completed project yet. Dave

From the sounds of it, you might want to change the Expand variable to wdSentence if it is just a single line. "fumei" would be better able to explain the paragraph characteristics than I (its a Word Styles thing). The funny blocks at the end of the string are the end of cell char. As soon as I find the link (its in the Word forum somewhere) i'll post it here as well. There was quite a discussion based on that little block and how to get rid of it.

here it is

[edit]
http://www.vbaexpress.com/forum/showthread.php?p=18551

That was a great link and very informative. I seemed to have got rid of the annoying square thingee with the code I added. Now to figure out how to copy a found paragraph along with the next three paragraphs. Thanks again. Dave

Hi, Dave! Welcome to VBAX!

1. Don't be afraid to post links at MrExcel to here and here to MrExcel. Heck...half our members came from there.

2. Don't forget to mark the thread solved by using the Thread Tools dropdown at the top of the thread.

3. Make a new thread if your next issue is not really related.

:)

Hi, seems to be a lot of code flying with this. As long as you have the Word library referenced you can use:

Code:

---

Dim oRange As Word.Range
Dim SourceDoc As Word.Document
Dim ThatDoc As Word.Document
Set SourceDoc = ActiveDocument
Documents.Add
Set ThatDoc = ActiveDocument
ThisDoc.Activate
Selection.HomeKey unit:=wdStory
With Selection.Find
    Do While (.Execute(findtext:="whatever", _
Forward:=True) = True) = True
        Set oRange = Selection.Paragraphs(1).Range
        oRange.MoveEnd unit:=wdParagraph, Count:=3
            ThatDoc.Activate
            Selection.TypeText Text:=oRange.Text & vbCrLf
            SourceDoc.Activate
        Set oRange = Nothing
    Loop
End With

---

which finds every instance of "whatever" (which of course could be a variable), and copies the paragraph it is in, PLUS the following three paragraphs into a new document.