Question

宏的目的如下：让我们说特别是主文件夹，我有多个子文件夹，子子文件夹，子子文件夹等。在主文件夹中找到不同扩展名的MS Office Word文件（例如doc，docx）in不同的子文件夹/子子文件夹/子子文件夹因此并非所有Word文件都在一个二/三层文件夹中。那些Word文件可能只有几千或几万，甚至只有几个houndred。

我正在寻找一种方法如何找到特定的单词（例如“水”）或特定的短语（例如“旧书”）甚至整个句子？因此，我要求的自动化工具会向我展示包含特定关键字的Word文件，包括特定关键字。

代码如下，我想知道我的代码有什么问题（请告诉我有问题的一行以及应该有什么代码），因为问题如下：

在我已经定义了搜索路径之后，在我已经定义了要搜索的文本/字符串之后，会出现以下消息：

“运行时错误'424'：需要对象”

如果我点击Debug按钮然后在代码的''如果FSO Is Nothing Then''的黄色背景中黄色背景，那么黄色箭头位于以下行的左侧：

If FSO Is Nothing Then Set FSO = CreateObject("scripting.filesystemobject")

CODE：

Sub Search()
    '
    ' Search Macro
    'Option Explicit

    Public FSO As Object 'a FileSystemObject
    Public oFolder As Object 'the folder object
    Public oSubFolder As Object 'the subfolders collection
    Public oFiles As Object 'the files object

    Dim i As Long, strNm As String, strFnd As String, strFile As String, strList As String

Sub FindTextInDocs()
    ' Minimise screen flickering
    Application.ScreenUpdating = False

    Dim StrFolder As String
    ' Browse for the starting folder
    StrFolder = Trim(InputBox("What is the Top Folder?", "Get Top Folder"))
    If StrFolder = "" Then Exit Sub

    strFnd = InputBox("What is the string to find?", "File Finder")
    If Trim(strFnd) = "" Then Exit Sub

    strNm = ActiveDocument.FullName
    ' Search the top-level folder
    Call GetFolder(StrFolder & "\")

    ' Search the subfolders for more files
    Call SearchSubFolders(StrFolder)

    ' Return control of status bar to Word
    Application.StatusBar = ""

    ' Restore screen updating
    Application.ScreenUpdating = True

    MsgBox i & " files processed." & vbCr & "Matches with " & strFnd & " found in:" & strList, vbOKOnly
End Sub


Function GetTopFolder() As String
    GetTopFolder = ""
    Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Choose a folder", 0)

    If (Not oFolder Is Nothing) Then GetTopFolder = oFolder.Items.Item.Path
    Set oFolder = Nothing
End Function


Sub SearchSubFolders(strStartPath As String)
    If FSO Is Nothing Then Set FSO = CreateObject("scripting.filesystemobject")

    Set oFolder = FSO.GetFolder(strStartPath)
    Set oSubFolder = oFolder.subfolders

    For Each oFolder In oSubFolder
        Set oFiles = oFolder.Files
        ' Search the current folder
        Call GetFolder(oFolder.Path & "\")
        ' Call ourself to see if there are subfolders below
        SearchSubFolders oFolder.Path
    Next
End Sub


Sub GetFolder(StrFolder As String)
    strFile = Dir(StrFolder & "*.doc", vbNormal)

    ' Process the files in the folder
    While strFile <> ""
        ' Update the status bar is just to let us know where we are
        Application.StatusBar = StrFolder & strFile
        i = i + 1
        Call DocTest(StrFolder & strFile)
        strFile = Dir()
    Wend
End Sub


Sub DocTest(strDoc As String)
    Dim Doc As Document

    ' Open the document
    If strDoc <> strNm Then
        Set Doc = Documents.Open(strDoc, AddToRecentFiles:=False, ReadOnly:=True, Format:=wdOpenFormatAuto, Visible:=False)
        With Doc
            With .Range
                With .Find
                    .Text = strFnd
                    .MatchCase = False
                    .MatchAllWordForms = False
                    .MatchWholeWord = False
                    .Execute
                    If .Found Then strList = strList & vbCr & strFile
                End With
            End With
            .Close SaveChanges:=False
        End With
    End If

    ' Let Word do its housekeeping
    DoEvents
    Set Doc = Nothing
End Sub

Answer 1

删除第一行，Sub Search（）

MS Word宏编程 - 此代码有什么问题？

1 个答案: