如何加快目录查找并突出显示VBA脚本?

时间:2017-05-10 20:14:06

标签: vba ms-word word-vba

我编写了一系列非常简单的函数来查找并突出显示包含同一目录中一系列文档中某些术语的文本段落。虽然功能正常,但是代码在某些文档上运行速度非常慢,我还没有真正建立它的特性(虽然我怀疑它们可能是文本框重,或者可能只包含大量空白段落进行测试什么都没有 - 稍后再说了。)

以下是代码:

Sub FindCheeses()
    Dim x As Object
    Dim sFolder As String
    Dim strFilePattern As String
    Dim strFileName
    Dim sFileName As String

    sFolder = "X:\Menus\"
    strFilePattern = "*.docx"
    strFileName = Dir(sFolder & strFilePattern)
    Do Until strFileName = vbNullString
        sFileName = sFolder & strFileName
        Set x = Documents.Open(sFileName)
        Call HighlightCheeses(x)
        ActiveDocument.Close (wdSaveChanges)

        Set x = Nothing
        strFileName = Dir()
    Loop
End Sub

Function HighlightCheeses(oWordDoc)
    Call HighlightStuff("roquefort", "cheddar", "wensleydale", oWordDoc)
End Function

Function HighlightStuff(x, y, z, oWordDoc) As String
    Dim rngStory As Object
    Dim i As Long
    Dim xPos As Integer, yPos As Integer, zPos As Integer
    Dim para As String

    For Each rngStory In oWordDoc.StoryRanges
        For i = 1 To rngStory.Paragraphs.Count
            para = rngStory.Paragraphs(i).Range.Text
            If para <> vbNullString Then
                xPos = InStr(1, para, x, vbBinaryCompare)
                yPos = InStr(1, para, y, vbBinaryCompare)
                zPos = InStr(1, para, z, vbBinaryCompare)
                If xPos <> 0 Then
                    rngStory.Paragraphs(i).Range.HighlightColorIndex = wdYellow
                End If
                If yPos <> 0 Then
                    rngStory.Paragraphs(i).Range.HighlightColorIndex = wdYellow
                End If
                If zPos <> 0 Then
                    rngStory.Paragraphs(i).Range.HighlightColorIndex = wdYellow
                End If
            End If
        Next i
    Next
End Function

我知道编写代码是一种奇怪的方式,但我试图让其他人适应它变得相对简单。是什么导致它在某些情况下运行缓慢?由于某种原因,对段落文本是否为空的测试似乎总是成功 - 这也可能是原因,但我不确定如何解决。

非常感谢任何建议 - 希望这个问题符合准则!

0 个答案:

没有答案