从Excel循环和更新MS访问数据库列的VBA代码

Question

背景 我有一个excel电子表格，可以从MS Access数据库中检索数据。该代码工作正常。它检索具有＆＃34;注释＆＃34;的记录。字段为空白。用户在Excel中更新注释字段并单击按钮。

问：点击按钮后，VBA代码必须遍历我的Excel工作表中所有检索到的记录以及标记为＆＃34;已完成的记录＆＃34;在excel中必须更新＆＃34;评论字段中的相同评论＆＃34;在我的数据库中。

我看了这篇文章， Gord Thompson 发布了一些可能适用于我的情况的代码;除了我不知道如何定制代码为我工作:( 链接 - VBA code to update / create new record from Excel to Access

**我的数据库结构的快照，并在此link

中表现出色

练成：

数据库：

此代码是否有效

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/en-us/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