VBA Excel-Access 3251运行时错误

时间:2016-08-03 01:07:38

标签: vba excel-vba ms-access-2007 excel-2007 excel

我目前使用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。

2 个答案:

答案 0 :(得分:1)

ANSWER

好的,问题是我在尝试"添加"时遇到了运行时错误。使用

创建数据库的新记录
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中打开了连接选项,选择了我的连接的属性,并将模式更改为以下&#34 ;;模式=共享拒绝无!"

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

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 Data Objects 6.1库

答案 1 :(得分:1)

我以为我会展示一个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