excel批量导入access报错（80004005）

kenccc

一个文件夹下有多个excel文件（从其他软件导出的文件，见样表），想用vba导入一个access表中，报错（截图见下），但我导正常的excel文件能成功，这些文件用excel打开后另存为时，显示是"文本文件（制表符分隔）"，不知是否受此影响？若是，应如何解决？望高手指导，盼！






Sub Macro1()
    Dim cnn As Object
    Dim cat  As Object, tb1 As Object
    Dim mydata$, Mypath$, myFile$, flag As Boolean
    mydata = ThisWorkbook.Path & "\数据库.mdb"
    Set cnn = CreateObject("adodb.connection")
    Set cat = CreateObject("ADOX.Catalog")
    If Dir(mydata) <> "" Then '如果“数据库.mdb”已经存在
        cat.ActiveConnection = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & mydata '利用ADOX取得数据表名
        For Each tb1 In cat.Tables
            If tb1.Type = "TABLE" Then
                If tb1.Name = "Sheet1" Then flag = True
            End If
        Next
    Else '如果“数据库.mdb”不存在，新建“数据库.mdb”数据库
        cat.Create "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & mydata
    End If
    Set cat = Nothing
    Set tb1 = Nothing
    cnn.Open "provider=microsoft.jet.oledb.4.0;data source=" & mydata
    Mypath = ThisWorkbook.Path & "\"
    myFile = Dir(Mypath & "*.xls")
    Do While myFile <> ""
        If myFile <> ThisWorkbook.Name Then
            If Not flag Then '如果“Sheet1”数据表不存在
                cnn.Execute "select * into .Sheet1 from [Excel 8.0;Database=" & Mypath & myFile & "].[Sheet1$A1:H]" '插入“Sheet1”数据表
                flag = True
            Else '“Sheet1”数据表已经存在
                cnn.Execute "insert into .Sheet1 select * from [Excel 8.0;Database=" & Mypath & myFile & "].[Sheet1$A1:H]" '插入新纪录
            End If
        End If
        myFile = Dir()
    Loop
    cnn.Close
    Set cnn = Nothing
    MsgBox "ok"
End Sub

kenccc

发现用excel打开后另存为“excel工作簿”也同样报错，我用的是office2003

Grant

是否你的ADO引用,或者版本不符问题,出现自动化错误一般都是这种情况

kenccc

如何解决呢？我尝试了在“工具--〉引用”中尝试了多种选择，仍然报同样的错；
另外，还尝试将这些文件用excel打开后另存为“excel工作簿”，还是不行，但如果复制表中内容再粘贴到新建的excel表时，就可以了。由于表格数量太多（几百个），手工操作太费时，也失去了用vba批量导入的意义了。还望各位高人指点！

Grant

尝试替换电脑上的ADO版本,可以先查看两个电脑ADO文件大小是否一样

kenccc

如何查看ADO文件大小?

Grant

ADO的路径
C:\Program Files\Common Files\System\ado