Excel-Access ADOの更新値

Question

Excelの値からExcelのテーブルを更新しようとしていますが、コードを実行するたびに既存のものを更新するのではなく新しい行が作成されます。私は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トンのため

多くのおかげで彼は'簡単なオプション'すべての行を更新します。

ただ、私の場合（.xlsm形式のExcelファイルとOffice 2007の）中で、私は例を再現するために、接続文字列を変更しなければならなかったことを共有する：...

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

を

以下は、逆の更新クエリの例です。ExcelのテーブルをAccessの値から更新します。 （Office 2007のとADO 2.8でテストし、.MDB形式で.xlsm形式とアクセスファイル内のファイルをエクセル）以下

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