VBA批量提取多工作簿指定单元格汇总时报1004文件未找到错误如何解决

错误原因 #

• 调用WScript执行CMD的Dir命令时，返回的输出末尾自带空行，Split生成的路径数组最后一个元素为空字符串，遍历到空路径时触发文件不存在错误
• 代码末尾ext标签后的冗余代码存在逻辑漏洞：循环正常结束后遍历指针rw已经超出路径数组的索引范围，执行打开文件操作时必然报错
• 默认文件过滤规则*.xlsx*末尾多余的通配符会匹配到Office生成的临时隐藏文件（文件名前缀为~$），这类文件本身无法直接打开

修复方案 #

1. 过滤路径数组中的空值和无效临时文件路径
2. 删除末尾冗余的错误跳转后打开文件的代码
3. 增加基础边界判断和错误处理逻辑，避免程序直接崩溃

修复后完整代码 #

Option Explicit

Sub Find_Files()
    Dim wb As Workbook
    Dim fldr As FileDialog
    Dim f As String, ibox As String
    Dim sn As Variant, oarray As Variant
    Dim rw As Long, rprw As Long, fileCount As Long
    
    ' 选择目标文件夹，处理取消操作
    Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
    If fldr.Show <> -1 Then Exit Sub
    f = fldr.SelectedItems(1) & "\"
    
    ' 输入文件过滤规则，处理取消操作
    ibox = InputBox("File Must Contain (Note * wildcards can be used)", , "*.xlsx")
    If ibox = "" Then Exit Sub
    
    ' 获取所有匹配文件路径
    sn = Split(CreateObject("wscript.shell").exec("cmd /c Dir """ & f & ibox & """ /s /a /b").StdOut.ReadAll, vbCrLf)
    
    ' 清空路径存储表（需确保CodeName为files的工作表存在）
    files.Cells.Clear
    files.Cells(1).Resize(UBound(sn) + 1) = Application.Transpose(sn)
    oarray = files.Cells(1, 1).CurrentRegion.Value
    
    ' 初始化汇总行号（需确保CodeName为kpi的工作表存在）
    rprw = kpi.Cells(Rows.Count, 1).End(xlUp).Row + 1
    fileCount = 0
    
    ' 遍历所有路径
    For rw = LBound(oarray) To UBound(oarray)
        ' 跳过空路径和临时文件
        If oarray(rw, 1) <> "" And InStr(oarray(rw, 1), "~$") = 0 Then
            On Error Resume Next ' 跳过无法打开的文件
            Set wb = Workbooks.Open(oarray(rw, 1), ReadOnly:=True)
            If Err.Number = 0 Then
                ' 写入指定单元格值
                With wb.Sheets(1)
                    kpi.Cells(rprw, 1) = .Range("C3")
                    kpi.Cells(rprw, 2) = .Range("C4")
                    kpi.Cells(rprw, 3) = .Range("C5")
                    kpi.Cells(rprw, 4) = .Range("C6")
                    kpi.Cells(rprw, 5) = .Range("C7")
                    kpi.Cells(rprw, 6) = .Range("C8")
                    kpi.Cells(rprw, 7) = .Range("G3")
                    kpi.Cells(rprw, 8) = .Range("C12")
                    kpi.Cells(rprw, 9) = .Range("D12")
                    kpi.Cells(rprw, 10) = .Range("E12")
                    kpi.Cells(rprw, 11) = .Range("F12")
                    kpi.Cells(rprw, 12) = .Range("H12")
                    kpi.Cells(rprw, 13) = .Range("I12")
                    kpi.Cells(rprw, 14) = .Range("J12")
                    kpi.Cells(rprw, 15) = .Range("L12")
                End With
                wb.Close SaveChanges:=False
                rprw = rprw + 1
                fileCount = fileCount + 1
            End If
            Err.Clear
            On Error GoTo 0
        End If
    Next
    
    Set wb = Nothing
    Set fldr = Nothing
    MsgBox "汇总完成，共有效处理" & fileCount & "个文件"
End Sub

注意事项 #

• 需确保当前工作簿中存在CodeName为files（存储路径列表）和kpi（存储汇总结果）的两个工作表
• 如果文件完整路径长度超过255字符，也会触发无法找到文件的错误，可通过缩短文件路径或启用Windows系统长路径支持解决

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