PDA

View Full Version : [SOLVED] Transfer paragraph(s)



Dave
03-17-2005, 08:27 AM
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



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

sandam
03-17-2005, 08:49 AM
it looks like your missing a select statement. something like below. might need more tweeking but hopefully it works.



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

Dave
03-17-2005, 09:03 AM
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



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

sandam
03-17-2005, 09:44 AM
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.

Zack Barresse
03-17-2005, 10:06 AM
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

Ken Puls
03-17-2005, 10:10 AM
Hi Dave,

I just wanted to post a link to the thread (http://www.mrexcel.com/board2/viewtopic.php?t=136269&highlight=transfer+paragraph) 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

Dave
03-17-2005, 10:25 AM
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

sandam
03-17-2005, 10:31 AM
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.

Dave
03-17-2005, 10:54 AM
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

sandam
03-18-2005, 03:28 AM
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.




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

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

Dave
03-18-2005, 09:03 AM
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

sandam
03-18-2005, 09:22 AM
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

Dave
03-18-2005, 01:36 PM
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

Anne Troy
03-18-2005, 01:42 PM
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.

:)

fumei
07-17-2005, 10:29 PM
Hi, seems to be a lot of code flying with this. As long as you have the Word library referenced you can use:


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.