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.