2016-03-21 206 views
0

嘗試從excel更新訪問表的時間相當長。我正在使用ADOB連接並通過具有更新的電子表格進行循環。這可以是從200條記錄到1000條記錄的任何地方。從Excel VBA更新Access 2010表只更新一條記錄

運行以下代碼時它將只更新訪問表中的一條記錄,儘管它顯示已經從我的測試數據更新了1047條記錄。

我正在更新具有62列的銷售記錄。列「BI」是引用時生成的唯一ID。更新指定的是將QorB列中的數據根據​​列「BI」(sQID)中的ID從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 
+0

是它字面上只顯示一個更改的記錄?或者只是說1條記錄發生了變化,因爲您在每次迭代時都會打開並關閉數據庫(這不是必要的,可能會減慢您的代碼速度)?並沒有一種方法來編寫一個'UPDATE QUERY'在你的ID列上加入一個ADODB中的excel數據?我想,這會更簡單,然後遍歷數千行。 –

+0

它在消息框1047中顯示更新的記錄。當我轉到訪問表並驗證第一個記錄是唯一已更新值的記錄時。 – cb122

+0

我現在看到你的問題了,我想:這行'sQID = Cells(2,61).Value'應該是sQID = Cells(lngRow,61).Value'。現在它在每個循環中設置相同的'sQID',這就是爲什麼第一條記錄是唯一更新的記錄。這似乎也是多餘的:'lngID = Cells(lngRow,61).Value'和'Upd'變量從不設置任何值,所以我認爲你的'Msgbox'只會返回'你剛更新的記錄' –

回答

0

你硬編碼此行:

sQID = Cells(lngRow, 61).Value 

然後:`SQID =細胞(2,61)。價值

你應該更換這個它將採取下一行的值,而不是繼續採用相同的值。

更新:斯科特·霍爾茲曼先到那裏!

0

,你想到這個代碼應工作:

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