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

问题描述

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

请求：点击按钮后，VBA代码必须循环遍历我的excel表中检索到的记录和在excel中标记为已完成的记录必须在数据库中的注释字段中更新相同的注释。

我已经看过在这篇文章和 Gord Thompson 发布了一些代码，可以为我的情况工作;除了我不知道如何定制代码为我工作（
链接 -
）

 更新tblCustomers 
 SET Email ='None'
 WHERE [Last Name] ='Smith'
  / pre> 
 
 
我想我们可以用上面的方法来做这样的事情：
  Sub update（）
 Dim cn As ADODB.Connection，rs As ADODB.Recordset 
 
'连接到Access数据库
 Set cn = New ADODB。 Connection 
 cn.OpenProvider = Microsoft.ACE.OLEDB.12.0;& _ 
Data Source = C：\Database1.mdb; 
 
'打开一个记录集
设置rs =新建ADODB.Recordset 
 rs.Opentablename，cn，adOpenKeyset，adLockOptimistic，adCmdTable 
 
 Dim r作为范围
设置范围（J2）的r = [J2]'缩写
 
而r.offset（0，-3）.Value> 0 
如果r.Value =Complete然后
 ticker = r.offset（0，-7）
 notes = r.offset（0，-1）
 
'创建查询字符串 - 这样吗？ 
 qString =UPDATE表名SET Notes ='&笔记& 'WHERE IBES_Ticker ='&代码
'现在把它放在数据库中：
 cn.Execute qString，dbFailOnError 
 
 End If 
 set r = r.offset（1,0）'go到下一行
 Wend 
 
'现在正确关闭你的连接... 
 
 rs.Close 
设置rs =没有
 cn.Close 
 Set cn = Nothing 
 
 End Sub 
  
 
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


                        
这篇关于从Excel中循环和更新MS访问数据库列的VBA代码的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！