Selecting a range of text..

[jag]

Thanks Helmut Weber for helping me with another part of this project, in a
previous post.

Just need help with the following part...

Needing to copy several sections of text from several hundred documents into
new documents (templates). I know where the text I need to copy from the old
documents is based on text headings before and after the "needed text".
Example below:

This is the top heading

text I need to copy is here,

This is the bottom heading

How do I go about setting the range start and range end based on my example
above??
I would need to search for the first heading, then the second heading, then
select and copy the text between those two points...

Thanks for all the help..

 

[jag]

thanks for the help, however....

set pH1, pH2 to the heading ranges (I assume you know how to use Find to do
that)

OK, need some help here. not sure how to set the pH1 and pH2 to the heading
ranges... sorry to need such details, still trying to pickup the VBA stuff..

thanks for all the help...

 

[Helmut Weber]

Hi Jag,
like this, as an example for the activedocument.
The heading style names are from my german version, of course.

Sub Makro17()
Dim rDcm As Range
Set rDcm = ActiveDocument.Range
Dim rtmp As Range
Set rtmp = Selection.Range
ResetSearch
again:
With rDcm.Find
.Style = "Überschrift 1"
If .Execute Then
rDcm.Select ' for testing
rDcm.Collapse direction:=wdCollapseEnd
rtmp.Start = rDcm.End
.Style = "Überschrift 8"
If .Execute Then
rDcm.Select ' for testing
rtmp.End = rDcm.Start - 1
rDcm.Collapse direction:=wdCollapseEnd
MsgBox "[" & rtmp.Text & "]"
GoTo again
End If
End If
End With
ResetSearch
End Sub
'---
Public 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
' plus some more
.Execute
End With
End Sub

Greetings from Bavaria, Germany

Helmut Weber, MVP
"red.sys" & chr(64) & "t-online.de"
Word XP, Win 98
http://word.mvps.org/

 

[jag]

OK, it's obvious I need to find a good VBA for Word book.... any
suggestions????

Below is the code I have so far pieced together, may not be the most
efficent, but so far I am able to get the section of text selected that I am
needing, still can't assign it to ptarget to get it into my other document...
What am I not doing???

Sub Create_New_Templates()
Dim MyFile As String
Dim Counter As Long
Dim AppraisalDoc As New Document
Dim curDoc As Document
Dim SourceDocRg As Range
Dim oDestRg As Range

Dim pH1 As Range
Dim pH2 As Range
Dim pTarget As Range
Dim lHeading1, lHeading2 As Integer



Const tHeading1 = "SUMMARY"
Const tHeading2 = "JOB QUALIFICATIONS"
Const strPath = "C:\workarea\testing\"

lHeading1 = Len(tHeading1)
lHeading2 = Len(tHeading2)


'*****************************************************
'Read directory for filenames into DirectoryListArray
'*****************************************************
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)


'*****************************************************
'Start looping through files, opening, reading data
'*****************************************************
For Counter = 0 To UBound(DirectoryListArray)
Set curDoc = Documents.Open(strPath & DirectoryListArray(Counter))
MsgBox strPath & DirectoryListArray(Counter)

Set pH1 = curDoc.Range
Set pH2 = curDoc.Range
'Set oDestRg = IssuesDoc.Range

ResetSearch
With pH1.Find
.Text = tHeading1
.MatchCase = True
.Execute
If .Found Then
'MsgBox pH1.Find.Text & " Found At " & pH1.End
ResetSearch
With pH2.Find
.Text = tHeading2
.MatchCase = True
.Execute
If .Found Then
MsgBox pH2.Find.Text & " Found At " & pH2.End
End If
End With

MsgBox curDoc.Range(pH1.End + 1, pH2.End - lHeading2)

pTarget = ActiveDocument.Range(Start:=pH1.End + 1,
End:=pH2.End - lHeading2)

End If
End With

curDoc.Close

Next
End Sub

Thanks to all....

 

[Jay Freedman]

Although you don't say exactly what happens, I'll guess you're getting
the error message about "object or With missing".

When you make a direct assignment to a Range or any other kind of
object (as opposed to a simple data type such as Integer or String),
you have to use the Set keyword:

Set pTarget = ActiveDocument.Range(...