成功循环遍历文件夹中的文件，但所有文件都打印损坏的错误

Question

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

它似乎有效，它正在文档，但随后它会为目录中的每个文件打印一条错误消息它损坏的子文件夹？顺便说一句，这些文件可以打开。他们似乎没有以任何方式损坏。他们确实有跟踪更改对了，难道这就是为什么？我为一个文件夹包含了一些示例输出在代码下方。

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

    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

一些大大简化的输出：

03100,03100 混凝土 Formwork.docx
05501,03200 混凝土 Reinforcement.docx
07920,03251 混凝土 Joints.docx
03600,03300 就地浇铸 Concrete.docx

~$100 混凝土 Formwork.docx - 5792 文件似乎已损坏。
~$200 混凝土 Reinforcement.docx - 5792 文件似乎已损坏。
~$251 混凝土 Joints.docx - 5792 文件似乎已损坏。
~$300 现场铸造 Concrete.docx - 5792 文件似乎已损坏。

有什么建议吗？另外，如果您在代码中看到任何其他错误，请放心纠正。谢谢！

Answer 1

~0 Concrete Formwork.docx
~0 Concrete Reinforcement.docx

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

成功循环遍历文件夹中的文件，但所有文件都打印损坏的错误

Looping through files in folder successfully but all files print corrupted error

vba

ms-word

vba7