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

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

只是为了在我的情况下分享它（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 " _

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

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

以下是反向更新查询的示例：根据 Access 中的值更新 Excel 中的表。 （使用Office 2007和ADO 2.8测试，excel文件为.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