Excel VBA指定子文件夹下TXT文件批量导入报错问题排查

看起来你遇到的核心问题是从手动选文件切换到自动遍历指定子文件夹文件时，路径构建错误或文件列表获取失败，导致了"文件未找到"的错误53。下面我会帮你修改代码，实现用户输入子文件夹名后自动导入该文件夹下所有TXT文件的功能，同时避免错误。

问题根源分析 #

错误53通常是因为程序尝试访问的文件/路径不存在：

• 你之前用Application.GetOpenFilename是让用户直接选文件，路径是系统自动生成的；但现在手动构建路径时，可能存在子文件夹名拼接错误、文件夹不存在或没有找到匹配的TXT文件的情况。
• 自行构建文件名数组时，可能没正确使用Dir函数遍历文件，导致数组为空或路径不完整。

修正后的完整代码 #

我把你的代码修改为自动获取指定子文件夹的TXT文件，关键改动部分会用注释标注：

Option Explicit
' Hold specific variables in memory for use between sub-routines
Public DDThreshold As Variant
Public FileName As String
Public FilePath As String
Public OpenFileName As Variant
Public OrderNum As Variant
Public SaveWorkingDir As String
Public SecondsElapsed As Double
Public StartTime As Double
Public TimeRemaining As Double

Sub Import_DataFile()
    ' Add an error handler
    On Error GoTo ErrorHandler
    ' Speed up this sub-routine by turning off screen updating and auto calculating until the end of the sub-routine
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    ' Define variable names and types
    Dim DefaultOpenPath As String
    Dim SaveWorkingDir As String
    Dim WholeFile As String
    Dim SplitArray
    Dim LineNumber As Integer
    Dim chkFormat1 As String
    Dim i As Long
    Dim n1 As Long
    Dim n2 As Long
    Dim fn As Integer
    Dim RawData As String
    Dim rngTarget As Range
    Dim rngFileList As Range
    Dim TargetRow As Long
    Dim FileListRow As Long
    Dim aLastRow As Long
    Dim bLastRow As Long
    Dim cLastRow As Long
    Dim dLastRow As Long
    Dim destCell As Range
    ' 新增变量用于处理文件夹和文件列表
    Dim targetFolder As String
    Dim fileArr() As String
    Dim fileName As String
    Dim idx As Integer

    ' Set the default path to start at when importing a file
    If Len(Dir("C:\AOI_DATA64\SPC_DataLog\IspnDetails", vbDirectory)) = 0 Then
        DefaultOpenPath = "C:\"
    Else
        DefaultOpenPath = "C:\AOI_DATA64\SPC_DataLog\IspnDetails\"
    End If

    ' 【关键改动1：让用户输入子文件夹名称】
    OrderNum = Application.InputBox("请输入订单号子文件夹名称：", "指定目标文件夹", Type:=2) 'Type=2确保输入文本
    ' 处理用户取消输入的情况
    If OrderNum = False Then
        MsgBox "" & vbNewLine & _
        " 未输入文件夹名称。" & vbNewLine & _
        "" & vbNewLine & _
        " 导入AOI检测数据已中止。", vbInformation, "操作取消"
        GoTo Cleanup '直接跳转到清理步骤
    End If

    ' 【关键改动2：构建完整的目标文件夹路径】
    targetFolder = DefaultOpenPath & OrderNum & "\"
    ' 检查目标文件夹是否存在
    If Len(Dir(targetFolder, vbDirectory)) = 0 Then
        MsgBox "" & vbNewLine & _
        " 指定的文件夹不存在：" & targetFolder & vbNewLine & _
        "" & vbNewLine & _
        " 导入AOI检测数据已中止。", vbExclamation, "文件夹未找到"
        GoTo Cleanup
    End If

    ' 【关键改动3：遍历目标文件夹下所有TXT文件，构建文件名数组】
    fileName = Dir(targetFolder & "*.txt")
    ' 检查是否有TXT文件
    If fileName = "" Then
        MsgBox "" & vbNewLine & _
        " 指定文件夹下未找到任何TXT文件。" & vbNewLine & _
        "" & vbNewLine & _
        " 导入AOI检测数据已中止。", vbInformation, "无文件可导入"
        GoTo Cleanup
    End If

    ' 初始化文件数组
    idx = 0
    ReDim Preserve fileArr(idx)
    fileArr(idx) = targetFolder & fileName

    ' 继续获取剩余的TXT文件
    fileName = Dir()
    Do While fileName <> ""
        idx = idx + 1
        ReDim Preserve fileArr(idx)
        fileArr(idx) = targetFolder & fileName
        fileName = Dir()
    Loop

    ' 将构建好的文件数组赋值给原变量，沿用后续的导入逻辑
    OpenFileName = fileArr

    ' 【以下是你原有的逻辑，无需修改】
    ' Clear contents and reset formatting of cells in all worksheets
    aLastRow = Worksheets("AOI Inspection Summary").Cells(Rows.Count, "B").End(xlDown).Row
    bLastRow = Worksheets("Raw Data").Cells(Rows.Count, "A").End(xlDown).Row
    cLastRow = Worksheets("Parsed Data").Cells(Rows.Count, "A").End(xlDown).Row

    Worksheets("AOI Inspection Summary").Range("E6:L14").ClearContents
    If aLastRow > 0 Then
        Worksheets("AOI Inspection Summary").Range("B24:L" & aLastRow).ClearContents
        Worksheets("AOI Inspection Summary").Range("B24:L" & aLastRow).ClearFormats
    End If

    If bLastRow > 0 Then
        Worksheets("Raw Data").Range("A1:Q" & bLastRow).ClearContents
        Worksheets("Raw Data").Range("A1:Q" & bLastRow).ClearFormats
    End If

    If cLastRow > 0 Then
        Worksheets("Parsed Data").Range("A1:Q" & cLastRow).ClearContents
        Worksheets("Parsed Data").Range("A1:Q" & cLastRow).ClearFormats
    End If

    Worksheets("AOI Inspection Summary").Range("E6:L9").NumberFormat = "@" 'Format cells to Text
    Worksheets("AOI Inspection Summary").Range("E10:L13").NumberFormat = "#,000" 'Format Cells to Number with commas
    Worksheets("AOI Inspection Summary").Range("E14:L14").NumberFormat = "0.00%" 'Format cells to Percent
    Worksheets("Raw Data").Columns("A:Z").EntireColumn.ColumnWidth = 8.09
    Worksheets("Parsed Data").Columns("A:Z").EntireColumn.ColumnWidth = 8.09

    ' 【这里你原代码截断了，后续的导入逻辑可以直接沿用，因为OpenFileName现在是正确的文件路径数组】

Cleanup:
    ' 恢复系统设置
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Exit Sub

ErrorHandler:
    MsgBox "发生错误：" & Err.Description & "（错误代码：" & Err.Number & "）", vbCritical, "导入失败"
    Resume Cleanup
End Sub

关键改动说明 #

1. 用户输入子文件夹名：用Application.InputBox的Type:=2确保用户输入的是文本，同时处理取消输入的情况。
2. 路径验证：拼接路径后先检查文件夹是否存在，避免后续访问不存在的路径导致错误53。
3. 遍历文件构建数组：用Dir函数遍历指定文件夹下的所有TXT文件，逐个添加到数组中，确保每个文件的路径都是完整且存在的。
4. 错误处理与清理：新增了Cleanup标签，确保无论成功还是失败，都能恢复Excel的屏幕更新和自动计算设置。

额外提示 #

• 如果子文件夹名可能包含特殊字符或空格，代码中的路径拼接已经处理了这种情况，因为Dir函数支持带空格的路径。
• 如果你需要更稳定的文件夹遍历，可以考虑使用FileSystemObject（需要引用Microsoft Scripting Runtime），但上面的Dir方法已经足够满足需求且无需额外引用。

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