用VBA代码从Excel中循环和更新MS access数据库的列[英] VBA code to loop and update MS access database column from Excel

问题描述

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.

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.

I have looked at this article and Gord Thompson posted 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

**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

推荐答案

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.

UPDATE I 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 )

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