1

此代码应该打开我的目标文件夹的子文件夹中的所有文件并搜索它们以查找特定术语，打印这些术语以及它们在文本文件中的位置。如果遇到错误，请打印该错误，以便我们知道要手动搜索哪些文档。

它似乎正在工作，它正在文档中查找搜索词，但随后它会为子文件夹中的每个文件打印一条错误消息，表明它已损坏？顺便说一句，这些文件可以打开。它们似乎没有以任何方式损坏。他们确实跟踪了变化，这可能是为什么？我在代码下方的一个文件夹中包含了一些示例输出。

最终代码：非常感谢大家的帮助

    Option Explicit

Sub CheckCrossRef()

    Dim FSO As Scripting.FileSystemObject
    Dim masterFolder As folder
    Dim allSubfolders As Folders
    Dim currSubfolder As folder
    Dim subfolderFiles As Files
    Dim currFile As File
    Set FSO = Nothing
    Dim leftChar As String
    
    Dim strFolder   As String
    Dim strDoc      As String
    Dim wordApp     As Word.Application
    Dim wordDoc     As Word.Document
    Dim nameArchive As Word.Document
    
    Set wordApp = New Word.Application
    wordApp.Visible = True
    Set nameArchive = Documents.Add(Visible:=False)
    
    Dim fd          As FileDialog
    Set fd = Application.FileDialog(msoFileDialogFolderPicker)
    With fd
        .Title = "Select the folder that contains the documents."
        If .Show = -1 Then
            strFolder = .SelectedItems(1) & "\"
        Else
            MsgBox "You did Not Select the folder that contains the documents."
            Exit Sub
        End If
    End With

    
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set masterFolder = FSO.GetFolder(strFolder)
    Set allSubfolders = masterFolder.subFolders

    
    For Each currSubfolder In allSubfolders
        
        Set subfolderFiles = currSubfolder.Files
        
        For Each currFile In subfolderFiles
            On Error GoTo errorProcess
            leftChar = Left(currFile.Name, 1)
            If leftChar <> "~" Then
            Set wordDoc = Word.Documents.Open(currFile.Path)
            
            With wordDoc
                Dim SearchTerm As String, i As Long, fileName As String
                Dim Rng As Range, Doc As Document, RngOut As Range
                Dim searchTerms As Variant
                fileName = currFile.Name
                searchTerms = [removed]
                For i = LBound(searchTerms) To UBound(searchTerms)
                    
                    SearchTerm = searchTerms(i)
                    
                    With ActiveDocument.Range
                        With .Find
                            .ClearFormatting
                            .Text = SearchTerm
                            .Forward = True
                            .Wrap = wdFindStop
                            .MatchWildcards = True
                            .Execute
                        End With
                        If .Find.Found Then
                            Dim valueFound As String
                            Do While .Find.Found
                                Set Rng = .Duplicate
                                valueFound = Rng.Text
                                nameArchive.Activate
                                ActiveDocument.Range(0, 0).Select
                                Selection.EndKey Unit:=wdStory
                                Selection.TypeText Text:=vbCrLf & valueFound & "," & fileName
                                
                                wordDoc.Activate
                                .Collapse wdCollapseEnd
                                .Find.Execute
                            Loop
                            
                        End If
                    End With
                Next
            End With
            wordDoc.Close
            End If
nextIteration:
        Next currFile
        
    Next
    
    Dim newPath
    newPath = FSO.BuildPath(masterFolder.Path, "SpecList.txt")
    nameArchive.SaveAs2 fileName:=newPath, FileFormat:=wdFormatText
    nameArchive.Close
    wordApp.Quit
    Set wordApp = Nothing
    
    Set FSO = Nothing
    valueFound = "null"
    Set Rng = Nothing
    Set masterFolder = Nothing
    Set allSubfolders = Nothing
    Set currSubfolder = Nothing
    Set subfolderFiles = Nothing
    Set currFile = Nothing
    
    Exit Sub
    
errorProcess:
    nameArchive.Activate
    ActiveDocument.Range(0, 0).Select
    Selection.EndKey Unit:=wdStory
    If Err.Number <> 0 Then
        If Not currFile Is Nothing Then
            fileName = currFile.Name
            Selection.TypeText Text:=vbCrLf & fileName & " " & Err.Number & " " & Err.Description
            
        Else
            Selection.TypeText Text:=vbCrLf & Err.Number & " " & Err.Description
            
        End If
        
    End If
    
    Resume nextIteration
    
    On Error GoTo 0
End Sub

一些大大简化的输出：

  1. 03100,03100 混凝土模板.docx
  2. 05501,03200 混凝土钢筋.docx
  3. 07920,03251 混凝土接头.docx
  4. 03600,03300 现浇混凝土.docx
  1. ~$100 Concrete Formwork.docx - 5792 文件似乎已损坏。
  2. ~$200 Concrete Reinforcement.docx - 5792 文件似乎已损坏。
  3. ~$251 Concrete Joints.docx - 5792 文件似乎已损坏。
  4. ~$300 Cast in Place Concrete.docx - 5792 文件似乎已损坏。

有什么建议吗？此外，如果您在代码中发现任何其他错误，请随时纠正。谢谢！

4

1 回答 1

1 
~$100 Concrete Formwork.docx
~$200 Concrete Reinforcement.docx

这些看起来像当有人打开文件进行编辑时 Word 生成的“锁定”文件。它不是一个实际的 Word 文件，因此您可能应该考虑排除任何以波浪号开头的文件。

于 2020-07-08T16:08:09.473 回答