Excel VBA批量导入Access数据库触发运行时错误1004如何解决

你遇到的Runtime error 1004核心为VBA字符串拼接语法错误：自定义路径变量percorso被写在了双引号内部，VBA会将其识别为普通文本而非路径值，导致OLEDB连接的数据源路径无效。同时代码还存在多余创建工作表、导入表重名的隐藏问题，修正后的完整代码如下：

Sub Importazione()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    Dim fso As Object
    Dim folder As Object
    Dim file As Object
    Dim percorso As String
    Dim nome As String
    Dim n As Integer
    Dim m As Integer
    Dim ultimo1 As Integer
    Dim ultimo2 As Integer
    Dim maxValue As Long
    Dim xWs As Worksheet    
    
    n = 2
    
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False

    For Each xWs In Application.ActiveWorkbook.Worksheets
        If xWs.Name <> "Home" Then
            xWs.Delete
        End If
    Next
             
        
    Set fso = CreateObject("scripting.Filesystemobject")
    Set folder = fso.GetFolder(ThisWorkbook.Path)
    For Each file In folder.Files
        If UCase(file.Name) Like "*.MDB" Then
            Debug.Print file.Path, file.Name
            
            nome = Replace(file.Name, ".mdb", "")         
            nome = Replace(nome, "-", "_")         
            percorso = file.Path
         
            Sheets.Add.Name = "Foglio" & n
            Sheets("Foglio" & n).Select
    
            ''' 修正后导入代码
            Application.CutCopyMode = False
            ' 删除了多余的新增工作表语句，避免生成空白表
            With ActiveSheet.ListObjects.Add(SourceType:=0, Source:=Array( _
                "OLEDB;Provider=Microsoft.ACE.OLEDB.12.0;Password="""";User ID=Admin;Data Source=" & percorso & ";Mode=Share Deny Write;Extended Properties="""";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Datab" _
                , _
                "ase Password="""";Jet OLEDB:Engine Type=5;Jet OLEDB:Database Locking Mode=0;Jet OLEDB:Global Partial Bulk Ops=2;Jet OLEDB:Global B" _
                , _
                "ulk Transactions=1;Jet OLEDB:New Database Password="""";Jet OLEDB:Create System Database=False;Jet OLEDB:Encrypt Database=False;Je" _
                , _
                "t OLEDB:Don't Copy Locale on Compact=False;Jet OLEDB:Compact Without Replica Repair=False;Jet OLEDB:SFP=False;Jet OLEDB:Support " _
                , _
                "Complex Data=False;Jet OLEDB:Bypass UserInfo Validation=False;Jet OLEDB:Limited DB Caching=False;Jet OLEDB:Bypass ChoiceField Va" _
                , "lidation=False"), Destination:=Range("$A$1")).QueryTable
                .CommandType = xlCmdTable
                .CommandText = Array("Test") ' 确保每个Access库中都有名为Test的表，否则修改为实际表名
                .RowNumbers = False
                .FillAdjacentFormulas = False
                .PreserveFormatting = True
                .RefreshOnFileOpen = False
                .BackgroundQuery = True
                .RefreshStyle = xlInsertDeleteCells
                .SavePassword = False
                .SaveData = True
                .AdjustColumnWidth = True
                .RefreshPeriod = 0
                .PreserveColumnInfo = True
                .SourceDataFile = percorso ' 修正赋值逻辑，直接传入路径变量
                .ListObject.DisplayName = "Tabella_" & nome ' 用文件名作为表名前缀，避免循环导入重名报错
                .Refresh BackgroundQuery:=False
            End With
            n = n + 1 ' 工作表序号自增
        End If
    Next 
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub

核心修改点说明 #

• 修正了连接字符串中Data Source的拼接逻辑：先关闭前半段字符串的双引号，拼接percorso变量后再拼接后半段连接参数
• 修正了SourceDataFile的赋值写法，不需要额外嵌套多层双引号，直接传入路径变量即可
• 删除了多余的ActiveWorkbook.Worksheets.Add语句，避免生成无意义的空白工作表
• 新增了工作表序号n的自增逻辑，避免循环创建工作表重名
• 修改了列表对象的显示名规则，用文件名变量nome拼接避免循环导入时重名报错
• 代码最后补全了屏幕更新、警告提示的恢复语句，避免后续操作Excel时功能异常

注意：代码中CommandText = Array("Test")默认读取Access中名为Test的表，如果你需要读取其他表/查询，自行修改对应名称即可。

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