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

11

经过一些实验,我最终得到以下代码,用于在MSWord中执行搜索和替换。这段代码在页眉和页脚中也能完美工作,包括页眉和/或页脚在第一页或奇偶页不同的情况。

问题在于,我需要为每个要替换的字符串调用MSWordSearchAndReplaceInAllDocumentParts,这样性能就变得不可接受(对于一个4页的word文档中的约50个字符串,需要2分钟)。理想情况下,它当然应该是“瞬间完成”的。

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

这是代码,底部放置了分析器结果:

// 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工具): 图片描述

请问你能帮忙找出问题所在吗?


3
请提供一个适当的样本文件,以便进行基准测试。 - menjaraz
@Yahia 是的,我同意这个事实:在加入页眉和页脚替换之前,这种方法足够快。我的主要担心是,似乎添加页眉和页脚替换后,它变得更慢了,就好像在进行搜索和替换时解析整个文档,而活动视图仅为页眉。 - UnDiUdin
抱歉,有一个关于性能分析结果还不清楚的地方。这些结果,是每次命中的时间,还是所有命中的总时间?因此,“与子项一起的时间”是针对1次命中的21.78秒,还是针对153次命中的总共21.78秒(因此仅替换需要0.14秒)。如果后者是真的,那么您的性能没有问题,恐怕无法加速。办公自动化相当慢。即使使用后期绑定,它仍然会很慢。 - The_Fox
@The_Fox 是的,这可能会更有效,但我不需要对153个字段进行搜索和替换,因为这些都是可用的字段,但在现实世界中,一个文档通常只包含5到15个字段,所以如果这是真的,如果我只在“找到”的字段上进行搜索%替换,那么我应该会有很大的改进。但是为了做到这一点,我应该能够将Word文档的所有内容(包括页眉和页脚以及所有变体:不同于第一页等)作为纯文本读取。然后我可以使用Delphi Pos函数定位使用哪些字符串,然后替换它们。(继续) - UnDiUdin
您也可以考虑使用OpenOffice OLE(https://dev59.com/DFzUa4cB1Zd3GeqP2FWO)进行操作。有时候(并非总是),对于相同的文档,它比MSWord更高效。 - philnext
显示剩余8条评论
1个回答

9

在我的机器上测试时,我没有看到如此糟糕的性能,但仍然有改进性能的方法。

最大的改进是在调用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打开文档(重新设置应用程序可见也会设置文档可见),您将看到更大的改进。


谢谢您的建议,我会尝试它们,它们很有道理。唯一我不明白的是wdPrintVIew,这样做的好处是什么? - UnDiUdin
另一个评论:在我的情况下,性能非常糟糕,因为我替换了大约150个字符串(根据分析器结果)。 - UnDiUdin
我改正了自己。通过一些技巧,我能够使用您的建议从21秒缩短到13秒。现在最终优化是仅调用搜索替换所需字段。您知道获取包括页眉和页脚在内的所有文档作为rtf的方法吗?这样我就可以使用Delphi Pos函数来定位字符串了。 - UnDiUdin
@user193655: 我的程序从11秒降到了6.5秒。但是当深入研究时,发现问题是在打开文档之前将Word应用程序本身设置为不可见所导致的。当我在Word应用程序不可见的情况下打开文档时,旧方法只需要5.3秒。因此,速度更快了。 - The_Fox
@user193655:我不知道如何检查字符串是否存在。我唯一能想到的方法是使用“查找”对话框,但您已经在使用它了。 - The_Fox
显示剩余5条评论

网页内容由stack overflow 提供, 点击上面的
可以查看英文原文,
原文链接