Speed up search/replace in VBA Word

Question

I have a word document with 450 pages (and growing) in witch I make a search and replace (linking referencies) after inserting new text. Unfortunately this procedure is very slow.

Have you any suggestions to speed up this search/replace-function? Eg. by defining the range for the funtion to only new added text since last saving the doc (no idea if that would be possible)?

Sub AddLinks_OG()
Dim Rng As Range, SearchString As String, Id As String, PathDatenServer As String, PathArchiv As String, LinkDatenServer As String, LinkArchiv As String
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
Set Rng = ActiveDocument.Range
SearchString = "([A-Z]{2}[0-9]{6})"
PathDatenServer = "\\Srvdat02\OGZ\Geschäft\S3\"
PathArchiv = "\\Srvarc01\OGZ\Geschäft\S3\"
 With Rng.Find
 .MatchWildcards = True
 Do While .Execute(findText:=SearchString, Forward:=False) = True
 Id = Rng.Text
 LinkDatenServer = PathDatenServer & Id & "-O\U.doc"
 LinkArchiv = PathArchiv & Id & "-O\U.doc"
 ' If file exists in local filesystem link to that
 If Dir(LinkDatenServer) <> "" Then
 ActiveDocument.Hyperlinks.Add Anchor:=Rng, _
 Address:=LinkDatenServer, _
 SubAddress:="", TextToDisplay:=Rng.Text
 Rng.Collapse wdCollapseStart
 ElseIf Dir(LinkArchiv) <> "" Then
 ' If file exists in archive link to archive
 ActiveDocument.Hyperlinks.Add Anchor:=Rng, _
 Address:=LinkArchiv, _
 SubAddress:="", TextToDisplay:=Rng.Text
 Rng.Collapse wdCollapseStart
 End If
 Loop
 End With
End Sub

Answer 1

One thing that is undoubtedly slowing you down is that you are reprocessing found text that is already hyperlinked. You should check that Rng.Text isn't already hyperlinked before you do all that work.

Do While .Execute(findText:=SearchString, Forward:=False) = True
 If Rng.Hyperlinks.Count = 0 Then
 'do your processing here
 End If
Loop

Although that will still perform the search on all of your previous text even if it skips processing them.

If you know that your unlinked text will always and only be at the end of the document, you could use a Boolean flag to stop searching once you hit found text that is already hyperlinked. Something like this:

Dim newText As Boolean
newText = True
With Rng.Find
 .MatchWildcards = True
 Do While newText
 If .Execute(findText:=SearchString, Forward:=False) Then
 newText = (Rng.Hyperlinks.Count = 0)
 Else
 newText = False
 End If
 If newText Then
 Id = Rng.Text
 'add your hyperlinks here
 End If
 Loop
End With

That should speed things up even more.