使用OLE和Delphi提高Word文档中搜索替换的性能

时间:2012-03-01 16:41:06

标签: delphi activex word-automation

经过一些实验后,我最终得到以下代码,以便在MSWord中执行搜索和替换。此代码在页眉和页脚中也能很好地工作,包括第一页或奇数/偶数页面的页眉和/或页脚不同的情况。

问题是我需要为我替换的每个字符串调用MSWordSearchAndReplaceInAllDocumentParts,并且我得到一个不可接受的性能(在4页doc字中大约50个字符串需要2分钟)。理想情况下,它当然应该是“瞬时的”。

在处理页眉和页脚之前,我只是在主文档中进行搜索和替换(使用wdSeekMainDocument)。在这种情况下,perofmrance是可以接受的(即使很慢)。我只是想知道它为什么这么慢:切换视图需要时间吗?通常页眉或页脚包含的单词很少,所以我预计页眉和页脚中的所有搜索和替换都不会使整体性能变得更糟。但这不是我观察到的。

这是代码,在底部我放置了探查器结果:

// 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;

在这里我粘贴分析结果(我有aqtime pro): enter image description here

请你帮我解决这个问题吗?

1 个答案:

答案 0 :(得分:8)

在我的机器上进行测试时,我没有看到如此糟糕的性能,但仍有一些方法可以提高性能。

最大的改进是在调用MSWordSearchAndReplaceInAllDocumentParts之前将aWordApp.ActiveWindow.Visible设置为False

第二项改进是将aWordApp.ScreenUpdating设为False

当您连续多次调用MSWordSearchAndReplaceInAllDocumentParts时,请应用上述设置一次。另外,在多次调用MSWordSearchAndReplaceInAllDocumentParts之前将ActiveWindow.ActivePane.View.Type设置为wdPrintView

修改

我通过改变你找到/替换的方式得到了另一个改进:不是改变SeekView,而是遍历所有部分并自己获取文档,页眉和页脚的范围,并在这些范围内进行查找/替换。

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;

如果在应用程序不可见时打开要修改的文档,或者使用Visible打开文档,您将看到更大的改进:= False; (再次将应用程序设置为可见也会将文档设置为可见)。