S
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.
("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.