Kod VBA do aktualizacji/utworzenia nowego rekordu z Excela do dostępu

Question

Próbowałem szukać wszędzie odpowiedzi, ale moje niskie umiejętności w VBA naprawdę nie pomagają mi zrozumieć, co próbuję kodować.

Mam ten kod do tej pory:

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 

Ten kod robi dokładnie to, co chcę tej pory. Wiem, że chcę dodać kawałek, który będzie sprawdzał, czy rekord istnieje w oparciu o 4 reguły: Produkty, Region, Kwartał_F i Rok_F Jeśli pasuje do nich, powinien zaktualizować inne pole (Jednostki_F, ARPU). Jeśli nie, powinien poprawnie uruchomić kod i utworzyć nowy rekord.

Twoja pomoc będzie bardzo doceniona, utknąłem tutaj i nie wiem, jak się wydostać.

Dziękuję

Answer 1

Po napisaniu tego się po prostu sobie sprawę, że używasz VBA więc moja odpowiedź nie będzie działać. Ale powinieneś być w stanie śledzić to, co się dzieje. Oto pomysł. I dla kolekcje VBA rzucić okiem na to:

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 2

Mam arkusza kalkulacyjnego Excel następujące dane począwszy od komórki A1

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

Mam tabeli o nazwie "Cennik" w mojej bazie danych Access, która zawiera następujące dane:

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

The foll wynikający Excel VBA zaktualizuje istniejące rekordy dostępu z nowymi cenami dla „zwykłej” i „premium” i dodać nowy wiersz w tabeli na „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 

Answer 3

nie mam wystarczająco dużo reputację po prostu skomentuj jedną z powyższych odpowiedzi. Rozwiązanie było doskonałe, ale jeśli masz mnóstwo rekordów w jednym wierszu, aby się zapętlić, łatwiej będzie zamknąć wszystko w pętli. Też miałem swoje dane w tabeli Excela (ale jeśli masz tylko zakres niedynamiczny, wpisz go jako zakres).

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 

To wszystko - wtedy po prostu zamknięte bazy danych/połączenia itp i dałem użytkownikowi komunikat, dane zostały napisane w

Jedyną rzeczą, którą naprawdę trzeba pamiętać, tutaj jest mój. userform nie ma (jeszcze) włączone sprawdzanie typu danych, ale to jest mój następny kawałek kodu. W przeciwnym razie możesz uzyskać wyjątki od programu Access lub bardzo źle wyglądające dane po otwarciu!