从 Excel 到 Access 更新/创建新记录的 VBA 代码
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/15709156/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
VBA code to update / create new record from Excel to Access
提问by user2225351
I have been trying to look everywhere for an answer, but my low based skills in VBA is really not helping me to figure what I am trying to code.
我一直试图到处寻找答案，但我在 VBA 方面的基础技能低下并没有帮助我弄清楚我想要编码的内容。
I have this code so far:
到目前为止我有这个代码：
Sub ADOFromExcelToAccess()
' exports data from the active worksheet to a table in an Access database
' this procedure must be edited before use
Dim cn As ADODB.Connection, rs As ADODB.Recordset, r As Long
' connect to the Access database
Set cn = New ADODB.Connection
cn.Open "Provider=Microsoft.ACE.OLEDB.12.0; " & _
"Data Source=\GSS_Model_2.4.accdb;"
' open a recordset
Set rs = New ADODB.Recordset
rs.Open "Forecast_T", cn, adOpenKeyset, adLockOptimistic, adCmdTable
' all records in a table
For i = 4 To 16
x = 0
Do While Len(Range("E" & i).Offset(0, x).Formula) > 0
' repeat until first empty cell in column A
With rs
.AddNew ' create a new record
.Fields("Products") = Range("C" & i).Value
.Fields("Mapping") = Range("A1").Value
.Fields("Region") = Range("B2").Value
.Fields("ARPU") = Range("D" & i).Value
.Fields("Quarter_F") = Range("E3").Offset(0, x).Value
.Fields("Year_F") = Range("E2").Offset(0, x).Value
.Fields("Units_F") = Range("E" & i).Offset(0, x).Value
.Update
' stores the new record
End With
x = x + 1
Loop
Next i
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing
End Sub
This code does exactly what I want thus far. I know want to add a piece that is going to check if the record exist based on 4 rules: Products, Region, Quarter_F and Year_F If it matches these, it should update the other field (Units_F, ARPU). If not, it should run the code properly and create a new record.
到目前为止，这段代码完全符合我的要求。我知道想要添加一个将根据 4 个规则检查记录是否存在的部分：产品、地区、Quarter_F 和 Year_F 如果匹配这些，则应更新其他字段（Units_F、ARPU）。如果没有，它应该正确运行代码并创建一个新记录。
Your help will be very much appreciated, I am stucked here and do not see how to get out.
非常感谢您的帮助，我被困在这里，不知道如何出去。
Thank you
谢谢
回答by Gord Thompson
I have an Excel spreadsheet with the following data starting in cell A1
我有一个 Excel 电子表格，其中包含从单元格 A1 开始的以下数据
product variety price
bacon regular 3.79
bacon premium 4.89
bacon deluxe 5.99
I have a Table named "PriceList" in my Access database which contains the following data
我的 Access 数据库中有一个名为“PriceList”的表，其中包含以下数据
product variety price
------- ------- -----
bacon premium 4.99
bacon regular 3.99
The following Excel VBA will update the existing Access records with the new prices for "regular" and "premium", and add a new row in the table for "deluxe":
以下 Excel VBA 将使用“常规”和“高级”的新价格更新现有 Access 记录，并在表中为“豪华”添加一个新行：
Public Sub UpdatePriceList()
Dim cn As ADODB.Connection, rs As ADODB.Recordset
Dim sProduct As String, sVariety As String, cPrice As Variant
' connect to the Access database
Set cn = New ADODB.Connection
cn.Open "Provider=Microsoft.ACE.OLEDB.12.0; " & _
"Data Source=C:\Users\Gord\Desktop\Database1.accdb;"
' open a recordset
Set rs = New ADODB.Recordset
rs.Open "PriceList", cn, adOpenKeyset, adLockOptimistic, adCmdTable
Range("A2").Activate ' row 1 contains column headings
Do While Not IsEmpty(ActiveCell)
sProduct = ActiveCell.Value
sVariety = ActiveCell.Offset(0, 1).Value
cPrice = ActiveCell.Offset(0, 2).Value
rs.Filter = "product='" & sProduct & "' AND variety='" & sVariety & "'"
If rs.EOF Then
Debug.Print "No existing record - adding new..."
rs.Filter = ""
rs.AddNew
rs("product").Value = sProduct
rs("variety").Value = sVariety
Else
Debug.Print "Existing record found..."
End If
rs("price").Value = cPrice
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 Nicholas Smith
I don't have enough reputation to just comment on one of the above answers. The solution was excellent, but if you have a ton of records in one row to loop over it can be easier to enclose everything into a loop. I also had my data in an Excel Table (but if you just have a non-dynamic range enter that as a range instead).
我没有足够的声誉来评论上述答案之一。该解决方案非常好，但是如果您在一行中有大量记录要循环，那么将所有内容都包含在一个循环中会更容易。我还在 Excel 表格中保存了我的数据（但如果您只有一个非动态范围，请将其输入为一个范围）。
Set LO = wb.Worksheets("Sheet").ListObjects("YOUR TABLE NAME")
rg = LO.DataBodyRange
'All of the connection stuff from above that is excellent
For x = LBound(rg) To UBound(rg)
'Note that first I needed to find the row in my table containing the record to update
'And that I also got my user to enter all of the record info from a user form
'This will mostly work for you regardless, just get rid of the L/Ubound and search
'Your range for the row you will be working on
If rg(x,1) = Me.cmbProject.Value Then
working_row = x
Exit For
End If
Next
For i = 2 To 17 ' This would be specific to however long your table is, or another range
'argument would work just as well, I was a bit lazy here
col_names(i-1) = LO.HeaderRowRange(i) 'Write the headers from table into an array
Data(i-1) = Me.Controls("Textbox" & i).Value 'Get the data the user entered
Next i
'Filter the Access table to the row you will be entering the data for. I didn't need
'Error checking because users had to select a value from a combobox
rst.Filter = "[Column Name] ='" & "Value to filter on (for me the combobox val)"
For i = 1 To 16 'Again using a len(Data) would work vs. 16 hard code
rst(col_names(i)).Value = Data(i)
Next i
That's it - then I just closed the database/connections etc. and Gave my user a message saying the data had been written in.
就是这样 - 然后我只是关闭了数据库/连接等，并给我的用户一条消息，说数据已经写入。
The ONLY thing you really do need to note here is my userform hasn't (yet) incorporated data type checking, but that is my next bit of code. Otherwise you can get exceptions from Access or some really bad looking data when you open it!
您真正需要在这里注意的唯一一件事是我的用户表单尚未（尚未）合并数据类型检查，但这是我的下一段代码。否则，当您打开它时，您可能会从 Access 中获得异常或一些非常糟糕的数据！
回答by Papa Burgundy
After writing this out I just realized that you are using VBA so my answer won't work. But you should be able to follow what's going on. Here's the idea though. And for VBA collections have a look at this:
写完之后，我才意识到您正在使用 VBA，所以我的答案不起作用。但是您应该能够了解正在发生的事情。不过，这就是想法。对于 VBA 集合，请查看以下内容：
// First build your list
Dim myRecords As New Collection
For i = 4 To 16
x = 0
Do While Len(Range("E" & i).Offset(0, x).Formula) > 0
var list = from t in myRecords
where t.Products == Range("C" & i).Value
&& t.Region == Range("B2").Value
&& t.Quarter == Range("E3").Offset(0, x).Value
&& t.Year == Range("E2").Offset(0, x).Value
select t;
var record = list.FirstOrDefault();
if (record == null)
{
// a record with your key doesnt exist yet. this is a new record so add a new one to the list
record = new CustomObject();
record.Products = Range("C" & i).Value;
// etc. fill in the rest
myRecords.Add(record);
}
else
{
// we found this record base on your key, so let's update
record.Units += Range("E" & i).Offset(0, x).Value;
}
x = x + 1
Loop
Next i
// Now loop through your custom object list and insert into database
