Giá trị cập nhật Excel-Access ADO

Question

Tôi đang cố cập nhật bảng trong Access từ các giá trị trong excel, tuy nhiên mỗi khi tôi chạy mã, nó tạo hàng mới thay vì cập nhật các hàng hiện có, bất kỳ ý tưởng nào? Tôi mới tham gia ADO, vì vậy mọi lời khuyên đều được đánh giá cao

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

Dưới đây là một số ghi chú.

Một ví dụ của việc cập nhật từng hàng

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

Một lựa chọn dễ dàng hơn: cập nhật tất cả các hàng

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

Cuộc gọi của bạn tới .AddNew đang tạo hàng mới.

Answer 3

Fionnuala

Nhiều Cám ơn t anh ta 'Tùy chọn dễ dàng hơn' để cập nhật tất cả các hàng.

Chỉ cần chia sẻ rằng trong trường hợp của tôi (Office 2007 với file Excel ở định dạng .xlsm) Tôi đã phải thay đổi chuỗi kết nối để tái sản xuất ví dụ:

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 " _

Dưới đây là ví dụ về truy vấn cập nhật ngược: cập nhật bảng trong Excel từ các giá trị trong Access. (thử nghiệm với Office 2007 và ADO 2.8, file excel định dạng .xlsm và truy cập tập tin ở định dạng .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 

Dưới đây là ví dụ tương tự nhưng sử dụng một đối tượng Recordset:

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