Sql Excel Access ADO更新值

我试图从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

---

您对.AddNew的调用正在创建新行。

以下是一些注释

逐行更新的示例

''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

On Error GoTo ExceptionHandling
With Application
    '.EnableEvents = False
    .ScreenUpdating = False
End With

Dim cnStr As String, sSQL As String, ArId As Variant, ArPrice As Variant, i As Integer, ws As Worksheet, LastRow as Long
Set ws = Sheets("Sheet1")
cnStr = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ActiveWorkbook.Path & "\Test.mdb;Jet OLEDB:Database Password=123"

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

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

With ws
    LastRow = .Cells(1000, 1).End(xlUp).Row
    ArId = Application.Transpose(.Range(.Cells(17, 1), .Cells(LastRow, 1)))
    ArPrice = Application.Transpose(.Range(.Cells(17, 3), .Cells(LastRow, 3)))

    For i = 1 To UBound(ArId)
        If ArPrice(i) = "" Then GoTo ContinueLoop
            sSQL = "UPDATE PRICES SET Price = " & Replace(ArPrice(i), ",", ".") & " WHERE Id =" & ArId(i)
            cmd.CommandText = sSQL
            'For statements that don't return records, execute the command specifying that it should not return any records
            'this reduces the internal work, so makes it faster
            cmd.Execute , , adCmdText + adExecuteNoRecords
            'another option using the connection object
            'cn.Execute sSQL, RecsAffected
            'Debug.Print RecsAffected
ContinueLoop:
    Next i
End With

CleanUp:
    On Error Resume Next
    With Application
        '.EnableEvents = True
        .ScreenUpdating = True
    End With
    On Error Resume Next
    Set cmd = Nothing
    cn.Close
    Set cn = Nothing
    Exit Sub
ExceptionHandling:
    MsgBox "Error: " & Err.Description & vbLf & Err.Number
    Resume CleanUp

菲昂努阿拉

非常感谢更新所有行的“更简单选项”

在我的例子（Office 2007，Excel文件为.xlsm格式）中，为了与大家分享这一点，我必须更改连接字符串，以便重现示例：

scn=“Provider=Microsoft.ACE.OLEDB.12.0；数据源=c:\docs\dbto.mdb”

…

和“[excel12.0xml；HDR=YES；IMEX=2；DATABASE=C:\Docs\WB.xls].[Sheet1$]b”\ucode>

编辑：一个逐行更新访问权限的示例（使用数组）

下面是反向更新查询的示例：从Access中的值更新Excel中的表。
（使用Office 2007和ADO 2.8测试，excel文件为.xlsm格式，access文件为.mdb格式）

下面是使用记录集对象的相同示例：

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

赞成更简单的选择。我喜欢那种格式。
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