Improve performance of Search Replace in Word document using OLE and Delphi

Question

After some experiments I ended up with the following code to perform Search and Replace in MSWord. This code works perfectly also in header and footer, including the cases in which header and/or footer are different for the first page or odd/even pages.

The problem is that I need to call MSWordSearchAndReplaceInAllDocumentParts for every string I replace, and I get an unacceptable performance (2 minutes for about 50 strings in a 4 pages doc word). Ideally it should be "instantaneous" of course.

Before handling headers and footers I was just doing search and replace in the main document (using wdSeekMainDocument). In that case the perofmrance was acceptable (even if quite slow). I just wonder why is it so slow: does switching view takes time? Typically headers or footers contain few words, so I expected that all the Search And Replace in headers and footers was not making the overall performance so worse. But this is not what I observed.

This is the code, at the bottom i put profiler results:

// global variable (just for convenience of posting to Stack Overflow)   
var
 aWordApp: OLEVariant; // global

// This is the function that is executed once per every  string I replace
function MSWordSearchAndReplaceInAllDocumentParts;
begin
    try
      iseekValue := aWordApp.ActiveWindow.ActivePane.View.SeekView;
      iViewType := aWordApp.ActiveWindow.ActivePane.View.Type;
      if iViewType <> wdPrintView then
        aWordApp.ActiveWindow.ActivePane.View.Type := wdPrintView;
      if aWordApp.ActiveDocument.PageSetup.OddAndEvenPagesHeaderFooter then
      begin
        Try
          aWordApp.ActiveWindow.ActivePane.View.SeekView := wdSeekEvenPagesFooter;
          SearchAndReplaceInADocumentPart;
        Except
            // do nothing ..it was not able to set above view
        end;
        Try
          aWordApp.ActiveWindow.ActivePane.View.SeekView := wdSeekEvenPagesHeader;
          SearchAndReplaceInADocumentPart;
        Except
          // do nothing ..it was not able to set above view
        end;
      end;
      if aWordApp.ActiveDocument.PageSetup.DifferentFirstPageHeaderFooter then
      begin
        Try
          aWordApp.ActiveWindow.ActivePane.View.SeekView := wdSeekFirstPageFooter;
          SearchAndReplaceInADocumentPart;
        Except
          // do nothing ..it was not able to set above view
        end;
        Try
          aWordApp.ActiveWindow.ActivePane.View.SeekView := wdSeekFirstPageHeader;
          SearchAndReplaceInADocumentPart;
        Except
          // do nothing ..it was not able to set above view
        end;
      end;
      //Replace in Main Docpart
      Try
        aWordApp.ActiveWindow.ActivePane.View.SeekView := wdSeekMainDocument;
        SearchAndReplaceInADocumentPart;
      Except
          // do nothing ..it was not able to set above view
      end;
      //Replace in Header
      Try
        aWordApp.ActiveWindow.ActivePane.View.SeekView := wdSeekCurrentPageHeader;
        SearchAndReplaceInADocumentPart;
      Except
          // do nothing ..it was not able to set above view
      end;
      //Replace in Footer
      Try
        aWordApp.ActiveWindow.ActivePane.View.SeekView := wdSeekCurrentPageFooter;
        SearchAndReplaceInADocumentPart;
      Except
          // do nothing ..it was not able to set above view
      end;
      //Replace in Header
      Try
        aWordApp.ActiveWindow.ActivePane.View.SeekView := wdSeekPrimaryHeader;
        SearchAndReplaceInADocumentPart;
      Except
        // do nothing ..it was not able to set above view
      end;
      //Replace in Footer
      Try
        aWordApp.ActiveWindow.ActivePane.View.SeekView := wdSeekPrimaryFooter;
        SearchAndReplaceInADocumentPart;
      Except
        // do nothing ..it was not able to set above view
      end;
    finally
      aWordApp.ActiveWindow.ActivePane.View.SeekView := iseekValue;
      if iViewType <> wdPrintView then
        aWordApp.ActiveWindow.ActivePane.View.Type := iViewType;
    end;
end;

// This is the function that performs Search And Replace in the selected View
 // it is called once per view

function SearchAndReplaceInADocumentPart;
begin
    aWordApp.Selection.Find.ClearFormatting;
    aWordApp.Selection.Find.Text := aSearchString;
    aWordApp.Selection.Find.Replacement.Text := aReplaceString;
    aWordApp.Selection.Find.Forward := True;
    aWordApp.Selection.Find.MatchAllWordForms := False;
    aWordApp.Selection.Find.MatchCase := True;
    aWordApp.Selection.Find.MatchWildcards := False;
    aWordApp.Selection.Find.MatchSoundsLike := False;
    aWordApp.Selection.Find.MatchWholeWord := False;
    aWordApp.Selection.Find.MatchFuzzy := False;
    aWordApp.Selection.Find.Wrap := wdFindContinue;
    aWordApp.Selection.Find.Format := False;
    { Perform the search}
    aWordApp.Selection.Find.Execute(Replace := wdReplaceAll);
end;

Here i paste profiling results (i have aqtime pro):

Can you please help me in pinpointing the problem?

Answer 1

I didn't see such terrible performance when testing on my machine, but still, there are ways to improve performance.

Biggest improvement is setting the aWordApp.ActiveWindow.Visible to False before calling MSWordSearchAndReplaceInAllDocumentParts.

Second improvement is setting aWordApp.ScreenUpdating to False.

When you are calling MSWordSearchAndReplaceInAllDocumentParts multiple times in a row, apply above settings once. Also, set ActiveWindow.ActivePane.View.Type to wdPrintView before calling MSWordSearchAndReplaceInAllDocumentParts multiple times.

Edit:

I got another improvement by changing the way you de find/replace: Instead of changing the SeekView, iterate through all the sections and get the range of the document, headers and footers yourself and do a Find/Replace over those ranges.

procedure TForm1.MSWordSearchAndReplaceInAllDocumentParts(const aDoc: OleVariant);
var
  i: Integer;
  lSection: OleVariant;
  lHeaders: OleVariant;
  lFooters: OleVariant;
  lSections: OleVariant;
begin
  lSections := aDoc.Sections;
  for i := 1 to lSections.Count do
  begin
    lSection := lSections.Item(i);
    lHeaders := lSection.Headers;
    lFooters := lSection.Footers;
    if lSection.PageSetup.OddAndEvenPagesHeaderFooter then
    begin
      SearchAndReplaceInADocumentPart(lHeaders.Item(wdHeaderFooterEvenPages).Range);
      SearchAndReplaceInADocumentPart(lFooters.Item(wdHeaderFooterEvenPages).Range);
    end;
    if lSection.PageSetup.DifferentFirstPageHeaderFooter then
    begin
      SearchAndReplaceInADocumentPart(lHeaders.Item(wdHeaderFooterFirstPage).Range);
      SearchAndReplaceInADocumentPart(lFooters.Item(wdHeaderFooterFirstPage).Range);
    end;
    SearchAndReplaceInADocumentPart(lHeaders.Item(wdHeaderFooterPrimary).Range);
    SearchAndReplaceInADocumentPart(lFooters.Item(wdHeaderFooterPrimary).Range);

    SearchAndReplaceInADocumentPart(lSection.Range);
  end;
end;

procedure TForm1.SearchAndReplaceInADocumentPart(const aRange: OleVariant);
begin
  aRange.Find.ClearFormatting;
  aRange.Find.Text := aSearchString;
  aRange.Find.Replacement.Text := aReplaceString;
  aRange.Find.Forward := True;
  aRange.Find.MatchAllWordForms := False;
  aRange.Find.MatchCase := True;
  aRange.Find.MatchWildcards := False;
  aRange.Find.MatchSoundsLike := False;
  aRange.Find.MatchWholeWord := False;
  aRange.Find.MatchFuzzy := False;
  aRange.Find.Wrap := wdFindContinue;
  aRange.Find.Format := False;

  { Perform the search}
  aRange.Find.Execute(Replace := wdReplaceAll);
end;

You will see even a bigger improvement if you open the document you want to modify while the application is invisible, or if you open the document with Visible := False; (setting the application visible again will also set the document visible).