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

VBA code to loop and update MS access database column from Excel

提问by marv

Background:I have an excel spreadsheet that retrieves data from an MS Access database. That code works fine. It retrieves records that have the "comments" field as blank. Users update the comments field in Excel and click a button.

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

The Ask:Once the button is clicked, the VBA code must loop through all retrieved records in my excel sheet and those records that are marked "completed" in excel must update the same comment in the "comments field" in my database.

问：单击按钮后，VBA 代码必须遍历我的 excel 表中所有检索到的记录，并且那些在 excel 中标记为“已完成”的记录必须更新我数据库中“评论字段”中的相同评论。

I have looked at this article and Gord Thompsonposted some code that could work for my situation; except that i dont know how to tailor that code to work for me :( Link-- VBA code to update / create new record from Excel to Access

我看过这篇文章，Gord Thompson发布了一些适用于我的情况的代码；除了我不知道如何定制该代码以适合我:( 链接 - VBA 代码更新/创建从 Excel 到 Access 的新记录

**Snapshot of the structure of my database and excel at this ** link

**我的数据库结构的快照，并在此 **链接中表现出色

excel:

擅长：

database:

数据库：

Will this code work

这段代码能用吗

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

采纳答案by Floris

I am not sure what bit of the adaptation you are struggling with. The following might help:

我不确定您正在努力适应哪些方面。以下可能有帮助：

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

Is that the bit you had difficulty with? If it is something else, please leave a comment.

那是你有困难的地方吗？如果是其他的，请留下评论。

UPDATEI don't have Access, so it is a little bit hard to give more guidance. However, I found the following code snippet for updating a record in Access (see http://msdn.microsoft.com/en-us/library/office/ff845201(v=office.15).aspx)

更新我没有访问权限，因此提供更多指导有点困难。但是，我发现以下代码片段用于更新 Access 中的记录（请参阅http://msdn.microsoft.com/en-us/library/office/ff845201(v=office.15).aspx）

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

I think we can use that with the above and do something like this:

我认为我们可以将其与上述内容结合使用并执行以下操作：

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