VBA code to update / create new record from Excel to Access

前端 未结 3 1460
野的像风
野的像风 2020-12-03 03:44

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

相关标签:
3条回答
  • 2020-12-03 04:28

    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
    

    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
    

    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
    
    0 讨论(0)
  • 2020-12-03 04:30

    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).

    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!

    0 讨论(0)
  • 2020-12-03 04:38

    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 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
    
    0 讨论(0)
提交回复
热议问题