从 Excel 到 Access 更新/创建新记录的 VBA 代码 [英] VBA code to update / create new record from Excel to Access
问题描述
我一直试图到处寻找答案,但我在 VBA 方面的基础技能低下并没有帮助我弄清楚我想要编码的内容.
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.
到目前为止我有这个代码:
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
到目前为止,这段代码完全符合我的要求.我知道想要添加一个片段,该片段将根据 4 个规则检查记录是否存在:产品、地区、Quarter_F 和 Year_F如果与这些匹配,则应更新其他字段(Units_F、ARPU).如果没有,它应该正确运行代码并创建一个新记录.
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.
非常感谢您的帮助,我被困在这里,不知道如何出去.
Your help will be very much appreciated, I am stucked here and do not see how to get out.
谢谢
推荐答案
我有一个 Excel 电子表格,其中包含从单元格 A1 开始的以下数据
I have an Excel spreadsheet with the following data starting in cell A1
product variety price
bacon regular 3.79
bacon premium 4.89
bacon deluxe 5.99
我的 Access 数据库中有一个名为PriceList"的表,其中包含以下数据
I have a Table named "PriceList" in my Access database which contains the following data
product variety price
------- ------- -----
bacon premium 4.99
bacon regular 3.99
以下 Excel VBA 将使用常规"和高级"的新价格更新现有的 Access 记录,并在表中为豪华"添加一个新行:
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":
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:UsersGordDesktopDatabase1.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
这篇关于从 Excel 到 Access 更新/创建新记录的 VBA 代码的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持IT屋!