excel追加access报错

nuo518

'引用Microsoft ActiveX Data Objects 2.x Library
Sub excel追加写入access()
    Dim cnn As New ADODB.Connection
    Dim rs As New ADODB.Recordset
    Dim myPath As String
    Dim myTable As String
    Dim SQL As String
    myPath = ThisWorkbook.Path & "\2016夏销售数据库.accdb"
    myTable = "2016夏零售A485"
    On Error GoTo errmsg
    cnn.Open "Provider=Microsoft.Ace.OLEDB.12.0;Data Source=" & myPath '连接数据库
   
    '生成数据库不存在记录的SQL语句
    SQL = "select a.* from [Excel 12.0;Database=" & ActiveWorkbook.FullName & "].[Sheet1$" & Range("A1").CurrentRegion.Address(0, 0) _
        & "] a left join " & myTable & " b on a.ID=b.ID where b.ID is null"
    Set rs = New ADODB.Recordset
    rs.Open SQL, cnn, adOpenKeyset, adLockOptimistic
   
    '插入数据库不存在记录
    If rs.RecordCount > 0 Then '如果工作表中含有数据库不存在记录
        SQL = "insert into " & myTable & " " & SQL '插入新记录SQL语句
        cnn.Execute SQL
        MsgBox rs.RecordCount & "行数据已经添加到数据库！", vbInformation, "添加数据"
    Else
         MsgBox "工作表的数据数据库中已经存在。", vbInformation, "添加数据失败"
    End If
   
    '关闭连接释放内存
    rs.Close
    cnn.Close
    Set rs = Nothing
    Set cnn = Nothing
    Exit Sub
errmsg:
    MsgBox Err.Description, , "错误报告"
End Sub


上如上的宏，excel里大约有6万行，就报错如图，请问是什么原因，怎么处理？

roych

Access和Excel应该是两个不同的ADO链接，需要分别创建，因此，应该需要加上以下代码：
原代码需加入：
Dim cnn1 As New ADODB.Connection
cnn1.Open "Provider=Microsoft.Ace.OLEDB.12.0;extended properties=Excel 12.0;Data Source=" & ActiveWorkbook.FullName
原代码：rs.Open SQL, cnn, adOpenKeyset, adLockOptimistic
需修改为：
rs.Open SQL, cnn1, adOpenKeyset, adLockOptimistic

todaynew

不大可能有13万条记录吧，Excel应该只能有6万条记录。

nuo518

多谢，明白了

nuo518

roych 发表于 2016-5-24 09:12
Access和Excel应该是两个不同的ADO链接，需要分别创建，因此，应该需要加上以下代码：
原代码需加入：
Di ...

你好，请问要在哪个位置加如以上代码？ 我按你的方法做了，还是提示相同的问题，不知道是不是我放错了