Excel-Access ADO更新值

Question

我想从Excel中的值更新Access中的表，但是每次运行代码时，它都会创建新行而不是更新已存在的行，所有想法为什么？我是新来的ADO，所以任何建议是非常感谢

Private Sub SelectMaster() 

Dim db As New ADODB.Connection 
Dim connectionstring As String 
Dim rs1 As Recordset 
Dim ws As Worksheet 

Set ws = ActiveSheet 

connectionstring = "Provider=Microsoft.Jet.OLEDB.4.0; " & _ 
     "Data Source=C:\Users\Giannis\Desktop\Test.mdb;" 

db.Open connectionstring 

Set rs1 = New ADODB.Recordset 
rs1.Open "Men", db, adOpenKeyset, adLockOptimistic, adCmdTable 


r = 6 
Do While Len(Range("L" & r).Formula) > 0 
With rs1 
.AddNew 

.Fields("Eva").Value = ws.Range("L" & r).Value 
.Update 

End With 
r = r + 1 
Loop 

rs1.Close 

'close database 
db.Close 

'Clean up 
Set rs1 = Nothing 
Set rs2 = Nothing 
Set db = Nothing 
End Sub 

Answer 1

以下是一些注意事项。

按行

''Either add a reference to: 
''Microsoft ActiveX Data Objects x.x Library 
''and use: 
''Dim rs As New ADODB.Recordset 
''Dim cn As New ADODB.Connection 
''(this will also allow you to use intellisense) 
''or use late binding, where you do not need 
''to add a reference: 
Dim rs As Object 
Dim cn As Object 

Dim sSQL As String 
Dim scn As String 
Dim c As Object 

scn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=c:\docs\dbto.mdb" 

''If you have added a reference and used New 
''as shown above, you do not need these 
''two lines 
Set cn = CreateObject("ADODB.Connection") 
Set rs = CreateObject("ADODB.Recordset") 

cn.Open scn 

sSQL = "SELECT ID, SName, Results FROM [Test]" 

''Different cursors support different 
''operations, with late binding 
''you must use the value, with a reference 
''you can use built-in constants, 
''in this case, adOpenDynamic, adLockOptimistic 
''see: http://www.w3schools.com/ADO/met_rs_open.asp 

rs.Open sSQL, cn, 2, 3 

For Each c In Range("A1:A4") 
    If Not IsEmpty(c) And IsNumeric(c.Value) Then 
     ''Check for numeric, a text value would 
     ''cause an error with this syntax. 
     ''For text, use: "ID='" & Replace(c.Value,"'","''") & "'" 

     rs.MoveFirst 
     rs.Find "ID=" & c.Value 

     If Not rs.EOF Then 
      ''Found 
      rs!Results = c.Offset(0, 2).Value 
      rs.Update 
     End If 
    End If 
Next 

更容易的选择更新行的例子：所有行更新

scn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=c:\docs\dbto.mdb" 

Set cn = CreateObject("ADODB.Connection") 

cn.Open scn 

sSQL = "UPDATE [Test] a " _ 
    & "INNER JOIN " _ 
    & "[Excel 8.0;HDR=YES;IMEX=2;DATABASE=C:\Docs\WB.xls].[Sheet1$] b " _ 
    & "ON a.ID=b.ID " _ 
    & "SET a.Results=b.Results" 

cn.Execute sSQL, RecsAffected 
Debug.Print RecsAffected 

Answer 2

您的.AddNew呼叫正在创建新的行。

Answer 3

Fionnuala

非常感谢在t他'更简单的选项'更新所有行。

只是为了分享我的情况（Office 2007与在.XLSM格式的Excel文件），我不得不改变连接字符串以重现例如：

scn = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=c:\docs\dbto.mdb"
...
& "[Excel 12.0 Xml;HDR=YES;IMEX=2;DATABASE=C:\Docs\WB.xls].[Sheet1$] b " _

下面是一个反向更新查询的示例：使用Access中的值更新Excel中的表。 （与Office 2007和ADO 2.8测试，擅长于.XLSM格式和.MDB格式访问文件文件）

Sub Update_Excel_from_Access() 

Dim cn As ADODB.Connection 
Set cn = New ADODB.Connection 

'different options, tested OK 
'cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ActiveWorkbook.FullName & ";Extended Properties=""Excel 12.0;HDR=YES;"";" 
'cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ActiveWorkbook.FullName & ";Extended Properties=Excel 12.0 Xml;" 
cn.Open "Driver={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)};DBQ=" & ActiveWorkbook.FullName & ";ReadOnly=0;" 

Dim cmd As ADODB.Command 
Set cmd = New ADODB.Command 
Set cmd.ActiveConnection = cn 

cmd.CommandText = "UPDATE [Sheet1$] a " _ 
    & "INNER JOIN " _ 
    & "[;Database=" & ThisWorkbook.Path & "\data.mdb].[Test] b " _ 
    & "ON a.ID=b.ID " _ 
    & "SET a.Results=b.Results" 
cmd.Execute , , adCmdText 

'Another option, tested OK 
'sSQL = "UPDATE [Sheet1$] a " _ 
' & "INNER JOIN " _ 
' & "[;Database=" & ThisWorkbook.Path & "\data.mdb].[Test] b " _ 
' & "ON a.ID=b.ID " _ 
' & "SET a.Results=b.Results" 
'cn.Execute sSQL, RecsAffected 
'Debug.Print RecsAffected 

Set cmd = Nothing 
cn.Close 
Set cn = Nothing 
End Sub 

下面是相同的例子，但使用一个记录对象：

Sub Update_Excel_from_Access_with_Recordset() 
Dim sSQL As String 
On Error GoTo ExceptionHandling 

Dim cn As ADODB.Connection 
Set cn = New ADODB.Connection 
cn.CursorLocation = adUseServer 

'different options, tested OK 
'cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ActiveWorkbook.FullName & ";Extended Properties=""Excel 12.0;HDR=YES;"";" 
'cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ActiveWorkbook.FullName & ";Extended Properties=Excel 12.0 Xml;" 
cn.Open "Driver={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)};DBQ=" & ActiveWorkbook.FullName & ";ReadOnly=0;" 

'Create a recordset object 
Dim rst As ADODB.Recordset 
Set rst = New ADODB.Recordset 

sSQL = "SELECT a1.Results As er, a2.Results As ar " _ 
    & "FROM [Sheet1$] a1 INNER JOIN [;Database=" & ThisWorkbook.Path & "\data.mdb].[Test] a2 " _ 
    & " ON a1.[ID] = a2.[ID]" 

With rst 
    .CursorLocation = adUseServer 
    .CursorType = adOpenKeyset 
    .LockType = adLockOptimistic 
    .Open sSQL, cn 
    If Not rst.EOF Then 
    Do Until rst.EOF 
     rst!er = rst!ar 
     .Update 
     .MoveNext 
    Loop 
    .Close 
    Else 
    .Close 
    End If 
End With 

CleanUp: 
Cancelled = False 
On Error Resume Next 
cn.Close 
Set rst = Nothing 
Set cn = Nothing 
Exit Sub 
ExceptionHandling: 
    MsgBox "Error: " & Err.description 
    Resume CleanUp 
End Sub