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库。

Answer 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中打开连接选项选中了我的连接的属性，并将模式更改为以下“; 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版本，现在的方法。正如我在代码中指出的那样，它需要参考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