VBA自动导入CSV遇1004错误：本地正常同事电脑异常求助

你的问题根源很清楚——宏里写死了绝对文件路径，同事的电脑上这个路径（C:\Users\Name\Dropbox\YGH\BYMKEW8 - Deel II\Uitwerking - kopie\Eerstejaars studenten ingeschreven hbo - kopie.csv）肯定和你的不一样，要么是用户目录名不同，要么Dropbox同步路径有差异，甚至文件存放位置都不一样，自然会触发“应用程序定义或对象定义错误”。

核心解决方案：改用相对路径 #

既然CSV文件和你的xlsm工作簿在同目录，我们可以用ThisWorkbook.Path来动态获取当前工作簿所在的文件夹路径，这样不管文件放到哪台电脑、哪个位置，只要CSV和xlsm在一起，就能正确找到。

修改后的宏代码 #

下面是调整后的完整代码，我还顺便优化了一些不必要的Select操作（这类操作不仅容易出错，还会降低宏的运行效率）：

Sub Auto_Open()
    ' Imports CSV
    Dim ws As Worksheet
    Dim csvPath As String
    
    ' 设置目标工作表
    Set ws = ThisWorkbook.Sheets("Blad1")
    
    ' 清除原有数据区域
    ws.Range("A9:BU156").Delete Shift:=xlToLeft
    
    ' 构建CSV文件的相对路径
    csvPath = ThisWorkbook.Path & "\Eerstejaars studenten ingeschreven hbo - kopie.csv"
    
    ' 检查路径是否有效（防止工作簿未保存的情况）
    If ThisWorkbook.Path = "" Then
        MsgBox "请先保存当前工作簿到指定目录，再运行宏！", vbExclamation
        Exit Sub
    End If
    
    ' 添加QueryTable导入CSV
    With ws.QueryTables.Add(Connection:= _
        "TEXT;" & csvPath, Destination:=ws.Range("$A$9"))
        .Name = "Eerstejaars studenten ingeschreven hbo - kopie"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 65001
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierNone
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = False
        .TextFileSemicolonDelimiter = True
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
    
    ' 设置表头格式
    With ws.Range("A9:R9")
        With .Font
            .ThemeColor = xlThemeColorAccent6
            .TintAndShade = 0
            .ColorIndex = xlAutomatic
            .Bold = True
        End With
        With .Interior
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
            .ThemeColor = xlThemeColorAccent6
            .TintAndShade = 0
            .PatternTintAndShade = 0
        End With
    End With
    
    ' 调整列宽
    ws.Columns("A:A").ColumnWidth = 11.86
    ws.Columns("F:F").ColumnWidth = 25.86
    ws.Columns("G:G").ColumnWidth = 18
    ws.Columns("H:H").ColumnWidth = 21.14
    ws.Columns("I:I").ColumnWidth = 15.86
    ws.Columns("J:J").ColumnWidth = 26
    
    ' 定义名称
    ActiveWorkbook.Names.Add Name:="List", RefersToR1C1:="=Blad1!R9C1:R125C18"
    
    ' 回到A1单元格
    ws.Range("A1").Select
End Sub

关键修改点说明 #

• 用ThisWorkbook.Path & "\文件名.csv"替代固定路径，确保CSV和xlsm同目录时能被找到
• 添加了工作簿未保存的判断（ThisWorkbook.Path为空时提示用户保存），避免出现路径无效的情况
• 用ws对象直接操作工作表，去掉了所有不必要的Select和Selection，让宏更稳定高效

额外注意事项 #

• 确保同事的电脑上已经启用了宏（文件打开时要允许宏运行）
• 确认CSV文件的文件名和你代码里的完全一致，包括大小写（Windows系统虽然不区分大小写，但最好保持一致避免意外）

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