Excel-Access ADO更新值

问题描述 投票：5回答：3

我试图从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
sql excel vba ms-access ado
3个回答
6
投票

这是一些笔记。

逐行更新的示例

''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
3
投票

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

1
投票

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测试，.xlsm格式的excel文件和.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
最新问题
© www.soinside.com 2019 - 2024. All rights reserved.