Extracting a text block from multiple docs

[Sriram]

I am attempting to extract all the text occurring after a particular phrase
("Current Issues") in a bunch of Word documents in a folder.

I've gotten this far but it is not working correctly, in the copy and paste
part. How do I fix it so that the found text is extended to the end of the
document and duly pasted into my summary sheet?

Option Explicit

Sub Summary()
Dim MyFile As String
Dim Counter As Long
Dim IssuesDoc As New Document
Dim curDoc As Document
Dim oRng As Range
Const strPath = "C:\myFolder\"

Dim DirectoryListArray() As String
ReDim DirectoryListArray(1000)

MyFile = Dir$(strPath & "*.doc")
Do While MyFile <> ""
DirectoryListArray(Counter) = MyFile
MyFile = Dir$
Counter = Counter + 1
Loop

ReDim Preserve DirectoryListArray(Counter - 1)

For Counter = 0 To UBound(DirectoryListArray)
Set curDoc = Documents.Open(strPath & DirectoryListArray(Counter))
With curDoc.Range.Find
.Text = "Current Issues"
.MatchCase = False
.Execute
If .Found Then
'Here's where I lose it - the found text isn't selected:
Selection.EndKey Unit:=wdStory, Extend:=wdExtend
Selection.Copy
IssuesDoc.Range.Collapse wdCollapseEnd
IssuesDoc.Range.Paste
curDoc.Close
End If
End With
Next
End Sub

I'm not quite sure how to handle things _after_ finding my text.

 

[Helmut Weber]

Hi Sriram,
without goint into improvements in detail,
if you are searching a range, then the selection
doesn't move. So

With curDoc.Range.Find
.Text = "Current Issues"
.MatchCase = False
.Execute
If .Found Then
Selection.EndKey Unit:=wdStory, Extend:=wdExtend
Selection.Copy

....
leaves the selection where it is. Probably
somewhere else. ;-) If it has to be the selection
object, you want to work with, you have to
select, what you have found. Or still better,
what comes after it. Like this:
---
Sub Makro1()
Dim rDcm As Range
Resetsearch
Set rDcm = ActiveDocument.Range
With rDcm.Find
.Text = "2003"
If .Execute Then
rDcm.Start = rDcm.End
rDcm.End = ActiveDocument.Range.End
rDcm.Select
' whatever
End If
End With
Resetsearch
End Sub
'---
Sub Resetsearch()
With Selection.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = ""
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute
End With
End Sub

 

[Jay Freedman]

Hi Sriram,

The root of the problem is that you're trying to use the Ranges of the two
documents as if they could be collapsed or extended like an ordinary Range
object. They can't -- the Range property of a Document object is by
definition the range of the *entire* document. I don't know why trying to do
it doesn't cause an error -- just one of VBA's oddities.

To make this work, declare two Range objects oSourceRg and oDestRg. (You do
declare oRng but you never use it -- you can remove that declaration). After
the "Set curDoc" statement, insert

Set oSourceRg = curDoc.Range
Set oDestRg = IssuesDoc.Range

(By the way, I don't see where you're opening IssuesDoc -- don't forget
that.)

Change the next statement to

With oSourceRg.Find

When the search text is found, oSourceRg will now enclose only the word
"Current Issues" -- this could not happen with curDoc.Range. Forget about
the Selection and the Copy/Paste stuff; change the rest of the code to this:

If .Found Then
oSourceRg.End = curDoc.Range.End
Selection.Copy
oDestRg.Collapse wdCollapseEnd
oDestRg.FormattedText = oSourceRg.FormattedText
curDoc.Close
End If

Transferring the FormattedText from one range to the other accomplishes the
same thing as copy/paste without using the clipboard (so you don't wipe out
anything that might be stored there, and it's also faster).

 

[Jay Freedman]

Oops, I should proofread better... Delete the command Selection.Copy
from the code I showed, because it isn't necessary.

 

[Sriram]

Alrighty, that cleared up many things for me. Works great.

BTW, it apparently is not necessary to explicitly open IssuesDoc - it gets
automatically opened when the statement to add text is executed.

Thanks muchly!

Sriram