select a range of text from one Word document and copy into another Word document
The following works but there may be a more efficient way of doing this:
Sub FindIt()
Dim blnFound As Boolean
Dim rng1 As Range
Dim rng2 As Range
Dim rngFound As Range
Dim strTheText As String
Application.ScreenUpdating = False
Selection.HomeKey wdStory
Selection.Find.Text = "Title"
blnFound = Selection.Find.Execute
If blnFound Then
Selection.MoveRight wdWord
Set rng1 = Selection.Range
Selection.Find.Text = "Address"
blnFound = Selection.Find.Execute
If blnFound Then
Set rng2 = Selection.Range
Set rngFound = ActiveDocument.Range(rng1.Start, rng2.Start)
strTheText = rngFound.Text
MsgBox strTheText
End If
End If
'move back to beginning
Selection.HomeKey wdStory
Application.ScreenUpdating = True
End Sub
You can switch between documents using Activate, preferably using object variables.
Microsoft MVP Jay Freedman kindly revised this for me to work without the Selection object, making it much neater.
Sub RevisedFindIt()
' Purpose: display the text between (but not including)
' the words "Title" and "Address" if they both appear.
Dim rng1 As Range
Dim rng2 As Range
Dim strTheText As String
Set rng1 = ActiveDocument.Range
If rng1.Find.Execute(FindText:="Title") Then
Set rng2 = ActiveDocument.Range(rng1.End, ActiveDocument.Range.End)
If rng2.Find.Execute(FindText:="Address") Then
strTheText = ActiveDocument.Range(rng1.End, rng2.Start).Text
MsgBox strTheText
End If
End If
End Sub
The only remaining requirement is to get this text into the other document. Something like:
Documents(2).Range.Text = strTheText
This code will write to external file:
Sub RevisedFindIt_savetofile2 ()
' Purpose: display the text between (but not including)
' the words "Title" and "Address" if they both appear.
'This file will search current document only, the data in open word document.
Dim rng1 As Range
Dim rng2 As Range
Dim strTheText As String
Dim DestFileNum As Long
Dim sDestFile As String
sDestFile = "C:\test-folder\f12.txt" 'Location of external file
DestFileNum = FreeFile()
'A valid file number in the range 1 to 511,
'inclusive. Use the FreeFile function to obtain the next available file number.
Open sDestFile For Output As DestFileNum 'This opens new file with name DestFileNum
Set rng1 = ActiveDocument.Range
If rng1.Find.Execute(FindText:="Title") Then
Set rng2 = ActiveDocument.Range(rng1.End, ActiveDocument.Range.End)
If rng2.Find.Execute(FindText:="Address") Then
strTheText = ActiveDocument.Range(rng1.End, rng2.Start).Text
MsgBox strTheText 'writes string to a message box
Print #DestFileNum, strTheText 'Print # will write to external file with the text strTheText
End If
End If
Close #DestFileNum 'Close the destination file
End Sub