从 Excel 到 Access 更新/创建新记录的 VBA 代码

Question

我一直在尝试到处寻找答案，但我在 VBA 方面的基础技能确实无法帮助我弄清楚我要编写什么代码。

到目前为止我有这个代码：

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）。如果没有，它应该正确运行代码并创建一个新记录。

非常感谢您的帮助，我被困在这里，不知道如何出去。

谢谢

Answer 1

我有一个 Excel 电子表格，其中包含从单元格 A1 开始的以下数据

product  variety  price
bacon    regular  3.79
bacon    premium  4.89
bacon    deluxe   5.99

我的 Access 数据库中有一个名为“PriceList”的表，其中包含以下数据

product  variety  price
-------  -------  -----
bacon    premium  4.99
bacon    regular  3.99

以下 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

Answer 2

写完之后，我才意识到您使用的是 VBA，所以我的回答不起作用。但是您应该能够了解正在发生的事情。这是这个想法。对于 VBA 集合，请查看以下内容：

VBA Collections

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

Answer 3

我没有足够的声誉来评论上述答案之一。该解决方案非常好，但是如果您在一行中有大量记录要循环，则将所有内容都包含在一个循环中会更容易。我还在 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

就是这样 - 然后我关闭了数据库/连接等，并给我的用户一条消息，说数据已被写入。

您真正需要在这里注意的唯一一件事是我的用户表单尚未（）合并数据类型检查，但这是我的下一段代码。否则，当您打开 Access 时，您可能会从 Access 中获得异常或一些看起来很糟糕的数据！