web-dev-qa-db-fra.com

Code VBA pour mettre à jour/créer un nouvel enregistrement d'Excel vers Access

J'essayais de chercher une réponse partout, mais mes faibles compétences en VBA ne m'aident vraiment pas à comprendre ce que j'essaie de coder.

J'ai ce code jusqu'à présent: 

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

Ce code fait exactement ce que je veux jusqu'à présent. Je sais vouloir ajouter un élément qui va vérifier l’existence de l’enregistrement en fonction de 4 règles: Produits, Région, Quarter_F et Year_F . Si cela correspond, il devrait mettre à jour l’autre champ (Units_F, ARPU). Sinon, il devrait exécuter le code correctement et créer un nouvel enregistrement.

Votre aide sera très appréciée, je suis coincé ici et je ne vois pas comment sortir.

Je vous remercie

excelvbams-access
9
user2225351

J'ai une feuille de calcul Excel avec les données suivantes à partir de la cellule A1

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

J'ai une table nommée "PriceList" dans ma base de données Access qui contient les données suivantes

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

La VBA Excel suivante mettra à jour les enregistrements Access existants avec les nouveaux prix pour "normal" et "premium", et ajoutera une nouvelle ligne dans la table pour "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
7
Gord Thompson

Après avoir écrit ceci, je viens de me rendre compte que vous utilisez VBA, donc ma réponse ne fonctionnera pas. Mais vous devriez pouvoir suivre ce qui se passe. Voici l'idée cependant. Et pour les collections VBA, regardez ceci:

Collections VBA 

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

Je n'ai pas assez de réputation pour simplement commenter l'une des réponses ci-dessus. La solution était excellente, mais si vous avez une tonne d'enregistrements dans une ligne à boucler, il peut être plus facile de tout inclure dans une boucle. J'avais aussi mes données dans un tableau Excel (mais si vous avez simplement une plage non dynamique, saisissez-la à la place).

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

C'est tout - alors je viens de fermer la base de données/connexions, etc. et j'ai donné à mon utilisateur un message disant que les données avaient été écrites.

La SEULE chose que vous devez vraiment noter ici est que mon formulaire utilisateur n’a pas ( encore ) de vérification de type de données intégrée, mais c’est mon prochain morceau de code. Sinon, vous pouvez obtenir des exceptions auprès d'Access ou de très mauvaises données lorsque vous l'ouvrez!

0
Nicholas Smith