VBA代码更新/创建从Excel到Access的新记录 [英] 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个规则检查记录是否存在的部分：Products，Region，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:\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

这篇关于VBA代码更新/创建从Excel到Access的新记录的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！