Question

有很多时间尝试从excel更新访问表。我正在使用ADOB Connection并循环通过具有更新的电子表格。这可以是200记录到1000 +记录的任何地方。

运行以下代码时，尽管显示已从我的测试数据中更新了1047条记录，但它只会更新访问表中的一条记录。

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

模块运行后，它显示它已更新了1047条记录，但在打开访问数据库时，它只显示一条记录已更改..我不知所措。

以下代码可以看到任何严重错误吗？有没有更好的方法来更新来自excel的大量数据访问？

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

谢谢你看看这个。

我对具有相同结果的建议的代码进行了以下更改。

Snip of Access showing records

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
sQID = Cells(lngRow, 61).Value

'Do While lngRow <= LR

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

    Set rs = New ADODB.Recordset

       sSQL = "SELECT * FROM PandR WHERE QID ='" & sQID & "';"

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

        Do While lngRow <= LR

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

        End With

    'Next rng
    lngRow = lngRow + 1       

    Loop    

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

End Sub

Answer 1

您正在对此行进行硬编码：`sQID = Cells（2,61）.Value

您应将其替换为：

sQID = Cells(lngRow, 61).Value

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

更新：斯科特霍尔兹曼首先到达那里！

Answer 2

此代码应该按预期工作：

NULL

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

2 个答案: