Excel VBA批量导入Import文件夹文件报1004错误问题排查

我看了你的代码，确实存在两个关键问题导致了首次运行正常、二次运行报错的情况，下面给你拆解问题并提供修正后的完整代码：

问题根源 #

1. 循环起始的逻辑错误：
   你在定义UserFilename = Dir(...)获取第一个文件名后，进入循环的第一行就执行了UserFilename = Dir，这直接跳过了第一个文件的处理，而且会导致最后一次循环时UserFilename为空值，触发Open错误。

2. 文件路径缺失导致找不到文件：
   Dir函数返回的只是文件名（不带完整路径），当你第一次运行时，Excel的当前工作目录可能正好是Import文件夹，所以能找到文件；但当你关闭导入文件后，当前目录会切换回主工作簿所在的路径，第二次运行时Workbooks.Open(UserFilename)就会因为找不到文件而抛出1004错误。

修正后的完整代码 #

Sub Import_VDL_v2_Button()
    'Disable features'
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    Application.Calculation = xlManual
    
    'Set the target file for import.'
    Dim TargetWorkbook As Workbook
    Set TargetWorkbook = Application.ActiveWorkbook
    
    'Specifing file directory. 单独存储路径，避免重复拼接'
    Dim importPath As String
    importPath = "/Users/Name/Documents/Reporting/Data/Import/"
    
    'Start Loop for import.'
    Dim UserFilename As String
    UserFilename = Dir(importPath & "*.xls*") '第一次获取文件名'
    
    Do While Len(UserFilename) > 0
        '拼接完整路径，确保Open能找到文件'
        Dim fullFilePath As String
        fullFilePath = importPath & UserFilename
        
        Dim UserWorkbook As Workbook
        Set UserWorkbook = Application.Workbooks.Open(fullFilePath)
        
        'Define source and target sheet for copy.'
        Dim SourceSheet As Worksheet
        Set SourceSheet = UserWorkbook.Worksheets(1)
        Dim TargetSheet As Worksheet
        Set TargetSheet = TargetWorkbook.Worksheets(1)
        
        'Check for filter and if present, clear all filter in source sheet.'
        If SourceSheet.AutoFilterMode = True Then
            SourceSheet.AutoFilter.ShowAllData
        End If
        
        'Unhide all rows and columns in source sheet'
        SourceSheet.Columns.EntireColumn.Hidden = False
        SourceSheet.Rows.EntireRow.Hidden = False
        
        'Copy data from source to last row in target sheet.'
        Dim SourceLastRow As Long
        SourceLastRow = SourceSheet.Cells(SourceSheet.Rows.Count, "A").End(xlUp).Row
        Dim TargetLastRow As Long
        TargetLastRow = TargetSheet.Cells(TargetSheet.Rows.Count, "A").End(xlUp).Offset(1).Row
        
        '直接赋值代替复制粘贴，提升效率'
        TargetSheet.Range("A" & TargetLastRow & ":S" & TargetLastRow + SourceLastRow - 2).Value = _
            SourceSheet.Range("A2:S" & SourceLastRow).Value
        
        'Close import file without saving (避免修改源文件)'
        UserWorkbook.Close SaveChanges:=False
        TargetWorkbook.Save '直接指定目标工作簿保存，避免ActiveWorkbook的不确定性'
        
        '获取下一个文件名'
        UserFilename = Dir
    Loop
    
    'Enable features'
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    Application.Calculation = xlAutomatic
End Sub

关键修改点说明 #

• 单独存储导入路径：把Import文件夹路径单独存为变量importPath，每次拼接完整文件路径，确保Workbooks.Open能精准找到文件。
• 调整循环顺序：先处理当前获取的UserFilename，再在循环末尾调用Dir()获取下一个文件名，避免跳过第一个文件。
• 替换复制粘贴为直接赋值：相比Copy/PasteSpecial，直接赋值单元格值的方式运行更快，也避免了剪贴板的干扰。
• 明确关闭与保存对象：用UserWorkbook.Close SaveChanges:=False避免误修改源文件，用TargetWorkbook.Save代替ActiveWorkbook.Save，防止当前活动工作簿变化导致的错误。

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