VBA代碼從Excel循環和更新MS Access數據庫列

Question

背景：我有一個Excel電子表格，可以從MS Access數據庫中檢索數據。 該代碼工作正常。 它檢索具有“注釋”字段為空白的記錄。 用戶更新Excel中的注釋字段，然后單擊一個按鈕。

詢問：單擊按鈕后，VBA代碼必須遍歷我的excel工作表中的所有檢索到的記錄，並且那些在excel中標記為“已完成”的記錄必須更新數據庫中“評論字段”中的相同注釋。

我看了這篇文章， 戈德·湯普森 （ Gord Thompson）發布了一些可能適合我的情況的代碼。 除了我不知道如何定制適合我的代碼 :(鏈接-VBA代碼可從Excel更新到Access中創建新記錄

**我的數據庫結構快照，並在此** 鏈接中表現出色

Excel中：

數據庫：

這段代碼會工作嗎

Sub Update()
Dim cn As ADODB.Connection, rs As ADODB.Recordset
Dim xComments As String
Dim xType As String
Dim xIBES_Ticker As String
Dim xEditor As String
Dim xPRD_Year As String
Dim xPRD_Month As String
Dim xEvent_Date As String
Dim xReporting As String
Dim xNotes As String

' connect to the Access database
Set cn = New ADODB.Connection
cn.Open "Provider=Microsoft.ACE.OLEDB.12.0; " & _
"Data Source=C:\Database1.mdb;"

' open a recordset
Set rs = New ADODB.Recordset
rs.Open "tablename", cn, adOpenKeyset, adLockOptimistic, adCmdTable

Range("A2").Activate  ' row 1 contains column headings
Do While Not IsEmpty(ActiveCell)

'filter all columns and update all records back instead of looking for those marked with "complete"
'guessing this will be easier to do
rs.Filter = "Type='" & xType & "' AND IBES_Ticker='" & xIBES_Ticker & "' AND Editor='" & xEditor & "' AND PRD_Year='" & xPRD_Year & "' AND PRD_Month='" & xPRD_Month & "' AND Event_Date='" & xEvent_Date & "' AND Reporting='" & xReporting & "' AND Notes='" & xNotes & "' AND Comments='" & xComments & "' "
If rs.EOF Then
Debug.Print "No existing records found..."
rs.Filter = ""
Else
Debug.Print "Existing records found..."
End If

rs("Type").Value = xType
rs("IBES_Ticker").Value = xIBES_Ticker
rs("Editor").Value = xEditor
rs("PRD_Year").Value = xPRD_Year
rs("PRD_Month").Value = xPRD_Month
rs("Event_Date").Value = xEvent_Date
rs("Reporting").Value = xReporting
rs("Notes").Value = xNotes
rs("Comments").Value = xComments

rs.Update
Debug.Print "...record update complete."

ActiveCell.Offset(1, 0).Activate  ' next cell down
Loop
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing
End Sub

Answer 1

我不確定您正在努力適應哪些方面。 以下內容可能會有所幫助：

Sub update()
Dim r as Range
Set r = [J2]   ' shorthand for Range("J2")
While r.offset(0, -3).Value > 0
  If r.Value = "Complete" Then
    ' take this record and put it in the DB
  End If
Set r = r.offset(1,0) ' go to the next row
Wend

End Sub

那是您遇到困難的地方嗎？ 如果還有其他問題，請發表評論。

更新我沒有Access，因此提供更多指導有點困難。 但是，我發現以下代碼片段可用於更新Access中的記錄（請參閱http://msdn.microsoft.com/zh-cn/library/office/ff845201(v=office.15).aspx ）

UPDATE tblCustomers 
    SET Email = 'None' 
    WHERE [Last Name] = 'Smith' 

我認為我們可以將其用於上述操作，並執行以下操作：

Sub update()
Dim cn As ADODB.Connection, rs As ADODB.Recordset

' connect to the Access database
Set cn = New ADODB.Connection
cn.Open "Provider=Microsoft.ACE.OLEDB.12.0; " & _
  "Data Source=C:\Database1.mdb;"

' open a recordset
Set rs = New ADODB.Recordset
rs.Open "tablename", cn, adOpenKeyset, adLockOptimistic, adCmdTable

Dim r as Range
Set r = [J2]   ' shorthand for Range("J2")

While r.offset(0, -3).Value > 0
  If r.Value = "Complete" Then
    ticker = r.offset(0, -7)
    notes = r.offset(0, -1)

    ' create the query string - something like this?
    qString = "UPDATE table name SET Notes='" & notes & "' WHERE IBES_Ticker='" & ticker
    ' now put it in the database:
    cn.Execute qString, dbFailOnError

  End If
  set r = r.offset(1,0) ' go to the next row
Wend

' now close your connections properly…

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

End Sub