VBA目录文件关键字搜索脚本报Error62: Input Past End of File错误求助

错误原因分析 #

出现Error 62的核心原因主要有两个：

• 非文本文件读取异常：你的脚本直接用Input(LOF(txt), txt)读取所有文件，但像二进制文件（EXE、图片、压缩包等）、损坏的文本文件，或者编码非ANSI的文件，LOF()返回的文件大小和实际可读取的文本内容长度不匹配，导致读取时超出文件范围。
• 未处理文件访问异常：大量文件的目录中，可能存在文件被其他程序占用、无读取权限，或者文件本身为空的情况，直接读取会触发错误。

修复后的脚本 #

以下是加入错误处理、过滤非文本文件、优化读取逻辑的版本：

Sub findfiles()
    Dim startpath As String
    startpath = Cells(1, 2).Value
    Dim keyword As String, text As String
    keyword = Cells(2, 2).Value
    Dim returnpatharr() As Variant
    Dim returnfilearr() As Variant
    Dim i As Integer
    i = 0
    
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    ' 处理根目录及所有子文件夹的文件
    ProcessFolder fso.GetFolder(startpath), keyword, returnpatharr, returnfilearr, i
    
    ' 输出结果到单元格
    On Error GoTo msg
    If i > 0 Then
        Range("A5:A" & 4 + i).Value = Application.WorksheetFunction.Transpose(returnfilearr)
        Range("B5:B" & 4 + i).Value = Application.WorksheetFunction.Transpose(returnpatharr)
    End If
    
Done:
    Exit Sub

msg:
    MsgBox "No Results"
End Sub

' 递归处理文件夹（包括子文件夹）
Private Sub ProcessFolder(objFolder As Object, keyword As String, ByRef pathArr As Variant, ByRef fileArr As Variant, ByRef counter As Integer)
    Dim objFile As Object
    Dim txt As Integer
    Dim fileExt As String
    
    ' 处理当前文件夹的文件
    For Each objFile In objFolder.Files
        fileExt = LCase(objFolder.FSO.GetExtensionName(objFile.Path))
        ' 只处理常见文本文件，可根据需要添加扩展名
        Select Case fileExt
            Case "txt", "csv", "log", "vba", "bas", "docx" ' 可扩展其他文本类扩展名
                txt = FreeFile
                On Error Resume Next ' 捕获文件访问错误
                Open objFile.Path For Input As #txt
                If Err.Number = 0 Then ' 文件成功打开
                    On Error GoTo FileReadError ' 捕获读取错误
                    ' 逐行读取，避免一次性读取大文件或非文本文件的问题
                    Do While Not EOF(txt)
                        Line Input #txt, text
                        If InStr(1, text, keyword, vbTextCompare) > 0 Then
                            ' 找到关键字后立即停止读取，提升效率
                            ReDim Preserve pathArr(counter)
                            pathArr(counter) = objFile.Path
                            ReDim Preserve fileArr(counter)
                            fileArr(counter) = objFile.Name
                            counter = counter + 1
                            Exit Do ' 找到就不用继续读了
                        End If
                    Loop
                    Close #txt
                End If
                On Error GoTo 0 ' 恢复错误处理
        End Select
FileReadError:
        Close #txt ' 确保文件关闭
        On Error GoTo 0
    Next objFile
    
    ' 递归处理子文件夹
    Dim objSubFolder As Object
    For Each objSubFolder In objFolder.Subfolders
        ProcessFolder objSubFolder, keyword, pathArr, fileArr, counter
    Next objSubFolder
End Sub

关键优化点 #

• 递归遍历文件夹：原脚本只处理子文件夹，漏掉了根目录的文件，现在用递归函数处理所有层级的文件夹。
• 过滤文本文件：通过扩展名筛选只处理常见文本文件，避免读取二进制文件导致的错误。
• 逐行读取：替换一次性读取整个文件的方式，逐行检查关键字，既避免Error 62，又能在找到关键字后立即停止读取，提升效率。
• 完善的错误处理：添加文件打开、读取的错误捕获，确保即使某个文件读取失败，脚本也能继续运行。
• 文本比较模式：用vbTextCompare代替硬编码的1，可读性更好，且实现不区分大小写的搜索（如果需要区分，改成vbBinaryCompare即可）。

内容的提问来源于stack exchange，提问作者Possdawgers