execl工作表数据导入到ACCSEE数据库代码报错

暮烟批

execl工作表数据导入到ACCSEE数据库代码报错，请老师帮忙看一下。

魂断蓝桥

Sub 将工作表生成新数据表()
    Dim cnn As New ADODB.Connection
    Dim rs As ADODB.Recordset
    Dim sh As Worksheet
    Dim SQL As String
    cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.Path & "\模具库.accdb"
    For Each sh In Worksheets
        If sh.[a2] = "序号" Then
            Set rs = cnn.OpenSchema(adSchemaTables, Array(Empty, Empty, sh.Name, Empty))
            If Not rs.EOF Then cnn.Execute "DROP TABLE [" & sh.Name & "]"
            SQL = "SELECT * FROM [Excel 12.0;Database=" & ThisWorkbook.FullName & ";].[" & sh.Name & "$" & sh.[a1].CurrentRegion.Offset(1).Address(0, 0) & "] WHERE 单号 IS NOT NULL"
            SQL = "SELECT * INTO [" & sh.Name & "] FROM (" & SQL & ")"
            cnn.Execute SQL
        End If
    Next
    MsgBox "已经将工作表数据生成新数据表。", vbInformation, "生成新数据表"
    rs.Close
    cnn.Close
    Set rs = Nothing
    Set cnn = Nothing
End Sub

暮烟批

魂断蓝桥 发表于 2018-8-28 10:16
Sub 将工作表生成新数据表()
    Dim cnn As New ADODB.Connection
    Dim rs As ADODB.Recordset

谢谢老师的帮助。

暮烟批

魂断蓝桥 发表于 2018-8-28 10:16
Sub 将工作表生成新数据表()
    Dim cnn As New ADODB.Connection
    Dim rs As ADODB.Recordset

老师，在麻烦一下，我把Access的格式改为mdb格式公式报错，能再给解决一下吗，附件已上传，谢谢。

暮烟批

老师，excel导入Access，mdb格式代码报错，能帮忙在看一下吗。数据库密码为666666，谢谢。

魂断蓝桥

暮烟批 发表于 2018-8-28 16:06
老师，在麻烦一下，我把Access的格式改为mdb格式公式报错，能再给解决一下吗，附件已上传，谢谢。

Sub 将工作表生成新数据表()
    Dim cnn As New ADODB.Connection
    Dim rs As ADODB.Recordset
    Dim sh As Worksheet
    Dim SQL As String
    cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.Path & "\模具库.accdb"
    For Each sh In Worksheets
        If sh.[a2] = "序号" Then
            Set rs = cnn.OpenSchema(adSchemaTables, Array(Empty, Empty, sh.Name, Empty))
            If Not rs.EOF Then cnn.Execute "DROP TABLE [" & sh.Name & "]"
            SQL = "SELECT * FROM [Excel 12.0;Database=" & ThisWorkbook.FullName & ";].[" & sh.Name & "$" & sh.[a1].CurrentRegion.Offset(1).Address(0, 0) & "] WHERE 单号 IS NOT NULL"
            SQL = "SELECT * INTO [" & sh.Name & "] FROM (" & SQL & ")"
            cnn.Execute SQL
        End If
    Next
    MsgBox "已经将工作表数据生成新数据表。", vbInformation, "生成新数据表"
    rs.Close
    cnn.Close
    Set rs = Nothing
    Set cnn = Nothing
End Sub

chentonny

导个表格，有个更简单的办法，几行代码搞定。
Dim appAccess As Access.Application
Set appAccess = CreateObject("Access.Application")
myfile1 = "d:\XXX\AAA.xlsx"  ‘EXCEL表路径
With appAccess
       .OpenCurrentDatabase ThisWorkbook.path & "\BBB.accdb"  '数据库路径
       .DoCmd.TransferSpreadsheet acImport, 10, "表名", myfile1, True, ""
       .CloseCurrentDatabase
End With

魂断蓝桥

暮烟批 发表于 2018-8-28 16:10
老师，excel导入Access，mdb格式代码报错，能帮忙在看一下吗。数据库密码为666666，谢谢。

Sub 将工作表生成新数据表()
     Dim cnn As New ADODB.Connection
     Dim rs As ADODB.Recordset
     Dim sh As Worksheet
     Dim SQL As String
     cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _
                 "Data Source=" & ThisWorkbook.Path & "\Data.mdb;" & _
                 "Persist Security Info=False;" & _
                 "Jet OLEDB:Database Password=666666"
     For Each sh In Worksheets
         If sh.[a2] = "序号" Then
             Set rs = cnn.OpenSchema(adSchemaTables, Array(Empty, Empty, sh.Name, Empty))
             If Not rs.EOF Then cnn.Execute "DROP TABLE [" & sh.Name & "]"
             SQL = "SELECT * FROM [Excel 12.0;Database=" & ThisWorkbook.FullName & ";].[" & sh.Name & "$" & sh.[A1].CurrentRegion.Offset(1).Address(0, 0) & "] WHERE 单号 IS NOT NULL"
             SQL = "SELECT * INTO [" & sh.Name & "] FROM (" & SQL & ")"
             cnn.Execute SQL
         End If
     Next
     MsgBox "已经将工作表数据生成新数据表。", vbInformation, "生成新数据表"
     rs.Close
     cnn.Close
     Set rs = Nothing
     Set cnn = Nothing
End Sub

魂断蓝桥

暮烟批 发表于 2018-8-28 16:10
老师，excel导入Access，mdb格式代码报错，能帮忙在看一下吗。数据库密码为666666，谢谢。

cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _
                 "Data Source=" & ThisWorkbook.Path & "\Data.mdb;" & _
                 "Persist Security Info=False;" & _
                 "Jet OLEDB:Database Password=666666"

暮烟批

老师，看看这是怎么回事，谢谢。