Is it possible to apply the Find and Replace exclusively onthe inserted file?

[stranno]

Hi Everyone,
I wonder if it is possible to apply the find and replace procedure exclusively on the inserted file (document) and not on the whole document in which it is inserted.
The problem is that the size of the original document in which the file is inserted (sometimes more then 100 times) increases so that the find and replace procedure
takes more and more time.

Inserting 30 times (and execute find and replace) takes 12 seconds on my computer
60 times 32 sec
90 times 60 sec
120 times 104 sec

So it's is a non linear process.

The attached sample code will demonstrate what i mean. I guess the code line " With wdapp.Selection.Find" should be replaced by a more adequate one, focussed on
the inserted file only. But how? The code is executed in Excel therefore i have set a reference to MS Word

Sub Test()
Dim r As Long
Dim FiletoInsert As String
Dim wdapp As Word.Application
Dim wdTestDocument As Word.Document


On Error Resume Next
Set wdapp = GetObject(, "Word.Application")
If Err <> 0 Then
Set wdapp = CreateObject("Word.Application")
Err.Clear
End If
On Error GoTo 0

Set wdTestDocument = wdapp.Documents.Add
wdTestDocument.Activate

FiletoInsert = "C:\Test\DocumentContaining500Words.doc"
StartTime = Timer

For r = 1 To 120
With wdapp.Selection
.InsertFile Filename:=FiletoInsert, ConfirmConversions:=False
.InsertParagraphAfter
.Collapse Direction:=wdCollapseEnd
.InsertBreak Type:=wdSectionBreakNextPage
End With

wdapp.Selection.Find.ClearFormatting
wdapp.Selection.Find.Replacement.ClearFormatting
With wdapp.Selection.Find
.Text = "someword"
.Replacement.Text = "replaced word"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = True
.MatchWholeWord = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
wdapp.Selection.Find.Execute

With wdapp.Selection
If .Find.Forward = True Then
.Collapse Direction:=wdCollapseStart
Else
.Collapse Direction:=wdCollapseEnd
End If
.Find.Execute Replace:=wdReplaceAll
If .Find.Forward = True Then
.Collapse Direction:=wdCollapseEnd
Else
.Collapse Direction:=wdCollapseStart
End If
.Find.Execute
End With

wdTestDocument.Characters.Last.Select
wdapp.Selection.Collapse
Next r

wdapp.Visible = True
wdapp.Selection.GoTo What:=wdGoToSection, Which:=wdGoToFirst
EndTime = Timer
MsgBox "Elapsed time: " & CInt(EndTime - StartTime) & " seconds"
End Sub



regards, Stranno