从Excel VBA更新Access 2010表仅更新一条记录

尝试从excel更新access表花费了相当长的时间。我正在使用ADOB连接，并在有更新的电子表格中循环。这可以是200条记录到1000多条记录

当运行下面的代码时，它将只更新access表中的一条记录，尽管显示它已根据我的测试数据更新了1047条记录

我正在更新包含62列的销售记录。列“BI”是引用时生成的唯一ID。更新指定的是根据列“BI”（sQID）中的ID将QorB列中的数据从Q更改为B

模块运行后，它显示已从此更新了1047条记录，但打开access DB时，它仅显示一条记录已更改。。我不知所措

有人能看到下面的代码有什么明显的错误吗？是否有更好的方法使用excel中的大量数据更新access

Sub updatedbtest2()

Dim cn As ADODB.Connection, rs As ADODB.Recordset
Dim rng As Range
Dim lngRow As Long
Dim lngID, LR, Upd
Dim sSQL As String

'Get Last Row of range used 
LR = Range("BI" & Rows.Count).End(xlUp).Row

Upd = LR - 1   
lngRow = 2    
Do While lngRow <= LR
lngID = Cells(lngRow, 61).Value   

    Set cn = New ADODB.Connection
    cn.Open "Provider = Microsoft.ACE.OLEDB.12.0;" & _
    "Data Source=C:\Database\sales.accdb;"

sQID = Cells(2, 61).Value

    Set rs = New ADODB.Recordset

       sSQL = "SELECT * FROM P&R WHERE QuoteID ='" & sQID & "';"  

rs.Open Source:=sSQL, ActiveConnection:=cn, LockType:=adLockOptimistic

        ' update fields within table with values from spreadsheet.
        With rs
            .Fields("QorB") = Cells(lngRow, 60).Value
            .Fields("BDate") = Cells(lngRow, 62).Value
            .update
        End With        
    rs.update   
   'Next rng

lngRow = lngRow + 1

    rs.Close
    Set rs = Nothing
    cn.Close
    Set cn = Nothing       


Loop

MsgBox "You just updated " & Upd & " records"
End Sub

Sub-updatedbtest2（）
Dim cn作为ADODB.Connection，rs作为ADODB.Recordset
变暗rng As范围
长得一样长
低液位、低液位、高液位
将sSQL设置为字符串
'获取已使用范围的最后一行
LR=范围（“BI”和Rows.Count）.End（xlUp）.Row
Upd=LR-1
lngRow=2
当lngRow您正在硬编码这一行时，请执行以下操作：`sQID=Cells（2，61）.Value

您应将其替换为：

sQID = Cells(lngRow, 61).Value

然后它将从下一行获取值，而不是继续获取相同的值

更新：斯科特·霍尔兹曼第一个到达那里
 此代码应按预期工作：

Sub updatedbtest2()

Dim cn As ADODB.Connection, rs As ADODB.Recordset
Dim rng As Range
Dim lngRow As Long
Dim sQID, LR
Dim sSQL As String

LR = Range("A" & Rows.Count).End(xlUp).Row
'Debug.Print LR

'Upd = LR - 1
lngRow = 2

Set cn = New ADODB.Connection
cn.Open "Provider = Microsoft.ACE.OLEDB.12.0;" & _
    "Data Source=C:\Database\sales.accdb;"

Do While lngRow <= LR

    sQID = Cells(lngRow, 61).Value

    Set rs = New ADODB.Recordset
    sSQL = "SELECT * FROM PandR WHERE QID ='" & sQID & "';"

    With rs
        .Open Source:=sSQL, ActiveConnection:=cn, LockType:=adLockOptimistic

        .Fields("QorB") = Cells(lngRow, 60).Value
        .Fields("BDate") = Cells(lngRow, 62).Value

        .Update

    End With

    'Next rng
    lngRow = lngRow + 1

    rs.Close
    Set rs = Nothing

Loop

cn.Close
Set cn = Nothing

End Sub

Sub-updatedbtest2（）
Dim cn作为ADODB.Connection，rs作为ADODB.Recordset
变暗rng As范围
长得一样长
暗sQID，LR
将sSQL设置为字符串
LR=范围（“A”和Rows.Count）.End（xlUp）.Row
'Debug.Print LR
'Upd=LR-1
lngRow=2
Set cn=New ADODB.Connection
cn.Open“Provider=Microsoft.ACE.OLEDB.12.0；”_
“数据源=C:\Database\sales.accdb；”
当lngRow只是显示一个更改的记录时，您会这样做吗？或者只是说1条记录被更改了，因为每次迭代都会打开和关闭数据库（这是不必要的，可能会减慢代码的速度）？难道没有一种方法可以从ADODB中的excel数据中编写一个ID列上带有联接的
更新查询
？我认为这比在数千行中循环更简单。它显示在messagebox 1047记录更新中。当我转到access表并验证第一条记录是唯一更新了值的记录时。我现在看到了您的问题，我认为：这一行
sQID=Cells（2，61）。Value
应该是
sQID=Cells（lngRow，61）。Value
。现在它在每个循环上设置相同的
sQID
，这就是为什么第一条记录是唯一更新的记录。这似乎也是多余的：
lngID=Cells（lngRow，61）。Value
和
Upd
变量从未设置任何值，因此，我认为您的
Msgbox
只会返回
您刚刚更新的记录
Yes，并使用debug.print验证它是否在电子表格的每一行中迭代并显示要更新的值。从您上次的评论中，不清楚您是否真正看到了问题所在。你收到了吗？
Sub updatedbtest2()

Dim cn As ADODB.Connection, rs As ADODB.Recordset
Dim rng As Range
Dim lngRow As Long
Dim sQID, LR
Dim sSQL As String

LR = Range("A" & Rows.Count).End(xlUp).Row
'Debug.Print LR

'Upd = LR - 1
lngRow = 2

Set cn = New ADODB.Connection
cn.Open "Provider = Microsoft.ACE.OLEDB.12.0;" & _
    "Data Source=C:\Database\sales.accdb;"

Do While lngRow <= LR

    sQID = Cells(lngRow, 61).Value

    Set rs = New ADODB.Recordset
    sSQL = "SELECT * FROM PandR WHERE QID ='" & sQID & "';"

    With rs
        .Open Source:=sSQL, ActiveConnection:=cn, LockType:=adLockOptimistic

        .Fields("QorB") = Cells(lngRow, 60).Value
        .Fields("BDate") = Cells(lngRow, 62).Value

        .Update

    End With

    'Next rng
    lngRow = lngRow + 1

    rs.Close
    Set rs = Nothing

Loop

cn.Close
Set cn = Nothing

End Sub