VBA Excel-Access 3251 运行时错误

Question

我目前使用 Microsoft Office 2007，并将 Access 2007 数据库链接到 Excel 2007 数据库。到目前为止，一切都很好。我可以更新 Access 数据库，它会自动显示在 Excel 文件中。这就是我遇到问题的地方。

当我尝试从 Excel 中更新 Access 数据库时；我不断收到运行时 3251 错误。 =>运行时错误现已解决，但当我尝试添加数据时出现关于 NULL 值的新问题？

Sub ADODBExcelToAccess()
'Collecting data from the
    Dim cn As ADODB.Connection, rs As ADODB.Recordset, r As Long

    '---NOTE: Sheet is set to auto refresh data from the database on loading---

    ' connect to the Access database
    Set cn = New ADODB.Connection
    cn.Open "Provider=Microsoft.ACE.OLEDB.12.0; " & _
            "Data Source=" & Application.ActiveWorkbook.Path & "\linktest.accdb;"

    ' open a recordset (i.e. a table)
    Set rs = New ADODB.Recordset

    rs.Open "linktest", cn, adOpenKeyset, adLockOptimistic, adCmdTable

    ' all records in a table
    For i = 4 To 16
        x = 0

        Do While Len(Range("K" & i).Offset(0, x).Formula) > 0
            With rs
                'create a new record
                .AddNew
                .Fields("ID") = Range("A1" & i).Value
                .Fields("PriceID") = Range("B1").Value
                .Fields("ProductCode") = Range("C1").Value
                .Fields("Price") = Range("D1" & i).Value
                .Fields("CurrencyType") = Range("E1").Value
                .Fields("Type") = Range("F1").Value
                .Fields("Production") = Range("G1" & i).Value
                .Fields("Quantity") = Range("H1" & i).Value
                .Fields("Details") = Range("I1" & i).Value
                .Fields("DateUpdated") = Range("J1" & i).Value
                .Fields("Setup") = Range("K1" & i).Value

                ' stores the new record
                .Update

            End With
            x = x + 1
        Loop
    Next i
    rs.Close
    Set rs = Nothing
    cn.Close
    Set cn = Nothing
End Sub

我当前使用的参考库是 Active X Data Objects 2.1 Library。

Answer 1

回答

好的，所以问题是我在尝试将新记录“添加”到数据库时遇到运行时错误

Do While Len(Range("K" & i).Offset(0, x).Formula) > 0
        With rs
            'create a new record
            .AddNew
            .Fields("ID") = Range("A1" & i).Value ...

这样我就可以将 Excel 电子表格中的记录保存到 Access 数据库中（均为 office 2007）。

我在 Excel 中打开了连接选项，选择了我的连接属性并将模式更改为以下“;Mode=Share Deny None!”

所以现在我的连接字符串如下所示：

Provider=Microsoft.ACE.OLEDB.12.0;User ID=Admin;Data
Source=C:\linktest.accdb;Mode=Share Deny None;Extended Properties="";
Jet OLEDB:System database="";
Jet OLEDB:Registry Path="";Jet OLEDB:Engine Type=6;
Jet OLEDB:Database Locking Mode=1;Jet OLEDB:Global Partial Bulk Ops=2;
Jet OLEDB:Global Bulk Transactions=1;Jet OLEDB:
New Database Password="";Jet OLEDB:Create System Database=False;
Jet OLEDB:Encrypt Database=False;Jet 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

当我返回一个错误，指出我试图返回的数据给出了一个“NULL”值时，我遇到了第二个问题。这是因为我试图将数据保存在返回错误的数据库中的主键中。

我只是注释掉了这一行，这就解决了这个问题。

我还将引用更改为 Microsoft ActiveX 数据对象 6.1 库

Answer 2

我想我会展示一个 DAO 替代方案 - 它是现在使用较新 Access 版本的默认 db 方法。正如我在代码中所指出的，它需要引用 Microsoft Office 14.0 Access database engine Object Library 或您现在系统上的任何版本。

Option Explicit

Sub DAOExcelToAccess()
    ' Requires Reference To
    ' Microsoft Office 14.0 Access database engine Object Library

    Dim db      As DAO.Database
    Dim rs      As DAO.Recordset
    Dim strFile As String
    Dim i       As Integer
    Dim x       As Integer

    strFile = Application.ActiveWorkbook.Path & "\linktest.accdb"
    Set db = DBEngine.OpenDatabase(strFile)
    Set rs = db.OpenRecordset("linktest", dbOpenDynaset)
    With rs
        For i = 4 To 16
            x = 0

            ' repeat until first empty cell in column A
            Range("A2").Activate

            'create a new record
            .AddNew
            ' Remove ID if it is AutoIncrement field
            ' .Fields("ID") = Range("A1" & i).Value
            .Fields("Area") = "Test" & i
            .Fields("ProductCode") = Range("C1").Value
            .Fields("Price") = Range("D1" & i).Value
            .Fields("CurrencyType") = Range("E1").Value
            .Fields("Type") = Range("F1").Value
            .Fields("Production") = Range("G1" & i).Value
            .Fields("Quantity") = Range("H1" & i).Value
            .Fields("Details") = Range("I1" & i).Value
            .Fields("DateUpdated") = Range("J1" & i).Value
            .Fields("Setup") = Range("K1" & i).Value

            ' stores the new record
            .Update

             x = x + 1
        Next i

        .Close
    End With
End Sub